commit 8dafacd0419ea890af461c9d42d4642155681eec (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Sat Jan 16 15:06:04 2016 -0500 * lisp/emacs-lisp/syntax.el (syntax-ppss-table): New var (syntax-ppss): * lisp/font-lock.el (font-lock-fontify-syntactically-region): Use it. diff --git a/etc/NEWS b/etc/NEWS index 4265445..cb93979 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -73,6 +73,8 @@ different group ID. * Lisp Changes in Emacs 25.2 +** New var syntax-ppss-table to control the syntax-table used in syntax-ppss + ** Autoload files can be generated without timestamps, by setting `autoload-timestamps' to nil. diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index e20a210..c221a01 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -416,6 +416,9 @@ point (where the PPSS is equivalent to nil).") (error nil))) syntax-ppss-stats)) +(defvar-local syntax-ppss-table nil + "Syntax-table to use during `syntax-ppss', if any.") + (defun syntax-ppss (&optional pos) "Parse-Partial-Sexp State at POS, defaulting to point. The returned value is the same as that of `parse-partial-sexp' @@ -431,6 +434,7 @@ running the hook." (unless pos (setq pos (point))) (syntax-propertize pos) ;; + (with-syntax-table (or syntax-ppss-table (syntax-table)) (let ((old-ppss (cdr syntax-ppss-last)) (old-pos (car syntax-ppss-last)) (ppss nil) @@ -567,7 +571,7 @@ running the hook." ;; we may end up calling parse-partial-sexp with a position before ;; point-min. In that case, just parse from point-min assuming ;; a nil state. - (parse-partial-sexp (point-min) pos))))) + (parse-partial-sexp (point-min) pos)))))) ;; Debugging functions diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 3c1f01d..c79835d 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1564,6 +1564,7 @@ START should be at the beginning of a line." "Put proper face on each string and comment between START and END. START should be at the beginning of a line." (syntax-propertize end) ; Apply any needed syntax-table properties. + (with-syntax-table (or syntax-ppss-table (syntax-table)) (let ((comment-end-regexp (or font-lock-comment-end-skip (regexp-quote @@ -1598,7 +1599,7 @@ START should be at the beginning of a line." font-lock-comment-delimiter-face)))) (< (point) end)) (setq state (parse-partial-sexp (point) end nil nil state - 'syntax-table))))) + 'syntax-table)))))) ;;; End of Syntactic fontification functions. commit 56e1097584c13f2b6db85592769db1c6c36e9419 Author: Stefan Monnier Date: Sat Jan 16 15:03:42 2016 -0500 lisp/nxml: Use syntax-tables for comments * lisp/nxml/nxml-mode.el (nxml-set-face): Prepend. (nxml-mode): Set syntax-ppss-table. Use sgml-syntax-propertize-function for syntax-propertize-function. Let font-lock highlight strings and comments. (nxml-degrade): Don't touch "nxml-inside" property any more. (nxml-after-change, nxml-after-change1): Remove functions. (comment): Don't set fontify rule any more. (nxml-fontify-attribute): Don't highlight the value any more. (nxml-namespace-attribute-value-delimiter, nxml-namespace-attribute-value) (nxml-comment-delimiter, nxml-comment-content): Remove faces. * lisp/nxml/nxml-rap.el (nxml-scan-end): Remove. (nxml-get-inside, nxml-inside-start, nxml-inside-end): Use syntax-ppss. (nxml-clear-inside, nxml-set-inside): Remove. (nxml-scan-after-change): Remove function. (nxml-scan-prolog, nxml-tokenize-forward): Simplify. (nxml-ensure-scan-up-to-date): Use syntax-propertize. (nxml-move-outside-backwards): * lisp/nxml/nxml-outln.el (nxml-section-tag-backward): Adjust to new nxml-inside-start behavior. * lisp/nxml/nxml-util.el (nxml-debug-set-inside) (nxml-debug-clear-inside): Remove macros. * lisp/nxml/xmltok.el (xmltok-forward-special): Remove function. (xmltok-scan-after-comment-open): Simplify. diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index c6600b1..edc7414 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -37,6 +37,7 @@ ;; So we might as well just require it and silence the compiler. (provide 'nxml-mode) ; avoid recursive require (require 'rng-nxml) +(require 'sgml-mode) ;;; Customization @@ -147,16 +148,6 @@ This is not used directly, but only via inheritance by other faces." "Face used to highlight text." :group 'nxml-faces) -(defface nxml-comment-content - '((t (:inherit font-lock-comment-face))) - "Face used to highlight the content of comments." - :group 'nxml-faces) - -(defface nxml-comment-delimiter - '((t (:inherit font-lock-comment-delimiter-face))) - "Face used for the delimiters of comments, i.e., ." - :group 'nxml-faces) - (defface nxml-processing-instruction-delimiter '((t (:inherit nxml-delimiter))) "Face used for the delimiters of processing instructions, i.e., ." @@ -274,15 +265,6 @@ This includes ths `x' in hex references." "Face used for the delimiters of attribute values." :group 'nxml-faces) -(defface nxml-namespace-attribute-value - '((t (:inherit nxml-attribute-value))) - "Face used for the value of namespace attributes." - :group 'nxml-faces) - -(defface nxml-namespace-attribute-value-delimiter - '((t (:inherit nxml-attribute-value-delimiter))) - "Face used for the delimiters of namespace attribute values." - :group 'nxml-faces) (defface nxml-prolog-literal-delimiter '((t (:inherit nxml-delimited-data))) @@ -405,7 +387,9 @@ reference.") (defsubst nxml-set-face (start end face) (when (and face (< start end)) - (font-lock-append-text-property start end 'face face))) + ;; Prepend, so the character reference highlighting takes precedence over + ;; the string highlighting applied syntactically. + (font-lock-prepend-text-property start end 'face face))) (defun nxml-parent-document-set (parent-document) "Set `nxml-parent-document' and inherit the DTD &c." @@ -530,12 +514,11 @@ Many aspects this mode can be customized using (save-excursion (save-restriction (widen) - (setq nxml-scan-end (copy-marker (point-min) nil)) (with-silent-modifications - (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) - (setq-local syntax-propertize-function #'nxml-after-change) + (setq-local syntax-ppss-table sgml-tag-syntax-table) + (setq-local syntax-propertize-function sgml-syntax-propertize-function) (add-hook 'change-major-mode-hook #'nxml-cleanup nil t) ;; Emacs 23 handles the encoding attribute on the xml declaration @@ -552,7 +535,7 @@ Many aspects this mode can be customized using (setq font-lock-defaults '(nxml-font-lock-keywords - t ; keywords-only; we highlight comments and strings here + nil ; highlight comments and strings based on syntax-tables nil ; font-lock-keywords-case-fold-search. XML is case sensitive nil ; no special syntax table (font-lock-extend-region-functions . (nxml-extend-region)) @@ -579,12 +562,7 @@ Many aspects this mode can be customized using (error-message-string err)) (ding) (setq nxml-degraded t) - (setq nxml-prolog-end 1) - (save-excursion - (save-restriction - (widen) - (with-silent-modifications - (nxml-clear-inside (point-min) (point-max)))))) + (setq nxml-prolog-end 1)) ;;; Change management @@ -597,41 +575,6 @@ Many aspects this mode can be customized using (goto-char font-lock-beg) (set-mark font-lock-end))) -(defun nxml-after-change (start end) - ;; Called via syntax-propertize-function. - (unless nxml-degraded - (nxml-with-degradation-on-error 'nxml-after-change - (save-restriction - (widen) - (nxml-with-invisible-motion - (nxml-after-change1 start end)))))) - -(defun nxml-after-change1 (start end) - "After-change bookkeeping. -Returns a cons cell containing a possibly-enlarged change region. -You must call `nxml-extend-region' on this expanded region to obtain -the full extent of the area needing refontification. - -For bookkeeping, call this function even when fontification is -disabled." - ;; If the prolog might have changed, rescan the prolog. - (when (<= start - ;; Add 2 so as to include the < and following char that - ;; start the instance (document element), since changing - ;; these can change where the prolog ends. - (+ nxml-prolog-end 2)) - (nxml-scan-prolog) - (setq start (point-min))) - - (when (> end nxml-prolog-end) - (goto-char start) - (nxml-move-tag-backwards (point-min)) - (setq start (point)) - (setq end (max (nxml-scan-after-change start end) - end))) - - (nxml-debug-change "nxml-after-change1" start end)) - ;;; Encodings (defun nxml-insert-xml-declaration () @@ -957,11 +900,11 @@ faces appropriately." [1 -1 nxml-entity-ref-name] [-1 nil nxml-entity-ref-delimiter])) -(put 'comment - 'nxml-fontify-rule - '([nil 4 nxml-comment-delimiter] - [4 -3 nxml-comment-content] - [-3 nil nxml-comment-delimiter])) +;; (put 'comment +;; 'nxml-fontify-rule +;; '([nil 4 nxml-comment-delimiter] +;; [4 -3 nxml-comment-content] +;; [-3 nil nxml-comment-delimiter])) (put 'processing-instruction 'nxml-fontify-rule @@ -993,7 +936,7 @@ faces appropriately." 'nxml-fontify-rule '([nil nil nxml-attribute-local-name])) -(put 'xml-declaration-attribute-value +(put 'xml-declaration-attribute-value ;FIXME: What is this for? 'nxml-fontify-rule '([nil 1 nxml-attribute-value-delimiter] [1 -1 nxml-attribute-value] @@ -1112,28 +1055,11 @@ faces appropriately." 'nxml-attribute-prefix 'nxml-attribute-colon 'nxml-attribute-local-name)) - (let ((start (xmltok-attribute-value-start att)) - (end (xmltok-attribute-value-end att)) - (refs (xmltok-attribute-refs att)) - (delimiter-face (if namespace-declaration - 'nxml-namespace-attribute-value-delimiter - 'nxml-attribute-value-delimiter)) - (value-face (if namespace-declaration - 'nxml-namespace-attribute-value - 'nxml-attribute-value))) - (when start - (nxml-set-face (1- start) start delimiter-face) - (nxml-set-face end (1+ end) delimiter-face) - (while refs - (let* ((ref (car refs)) - (ref-type (aref ref 0)) - (ref-start (aref ref 1)) - (ref-end (aref ref 2))) - (nxml-set-face start ref-start value-face) - (nxml-apply-fontify-rule ref-type ref-start ref-end) - (setq start ref-end)) - (setq refs (cdr refs))) - (nxml-set-face start end value-face)))) + (dolist (ref (xmltok-attribute-refs att)) + (let* ((ref-type (aref ref 0)) + (ref-start (aref ref 1)) + (ref-end (aref ref 2))) + (nxml-apply-fontify-rule ref-type ref-start ref-end)))) (defun nxml-fontify-qname (start colon diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index 79e6406..289816a 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -888,7 +888,7 @@ Point is at the end of the tag. `xmltok-start' is the start." (nxml-ensure-scan-up-to-date) (let ((pos (nxml-inside-start (point)))) (when pos - (goto-char (1- pos)) + (goto-char pos) t)))) ((progn (xmltok-forward) diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index e68c8a4..e66289d 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -46,8 +46,7 @@ ;; look like it scales to large numbers of overlays in a buffer. ;; ;; We don't in fact track all these constructs, but only track them in -;; some initial part of the instance. The variable `nxml-scan-end' -;; contains the limit of where we have scanned up to for them. +;; some initial part of the instance. ;; ;; Thus to parse some random point in the file we first ensure that we ;; have scanned up to that point. Then we search backwards for a @@ -74,93 +73,33 @@ (require 'xmltok) (require 'nxml-util) +(require 'sgml-mode) -(defvar nxml-prolog-end nil +(defvar-local nxml-prolog-end nil "Integer giving position following end of the prolog.") -(make-variable-buffer-local 'nxml-prolog-end) - -(defvar nxml-scan-end nil - "Marker giving position up to which we have scanned. -nxml-scan-end must be >= nxml-prolog-end. Furthermore, nxml-scan-end -must not be an inside position in the following sense. A position is -inside if the following character is a part of, but not the first -character of, a CDATA section, comment or processing instruction. -Furthermore all positions >= nxml-prolog-end and < nxml-scan-end that -are inside positions must have a non-nil `nxml-inside' property whose -value is a symbol specifying what it is inside. Any characters with a -non-nil `fontified' property must have position < nxml-scan-end and -the correct face. Dependent regions must also be established for any -unclosed constructs starting before nxml-scan-end. -There must be no `nxml-inside' properties after nxml-scan-end.") -(make-variable-buffer-local 'nxml-scan-end) (defsubst nxml-get-inside (pos) - (get-text-property pos 'nxml-inside)) - -(defsubst nxml-clear-inside (start end) - (nxml-debug-clear-inside start end) - (remove-text-properties start end '(nxml-inside nil))) - -(defsubst nxml-set-inside (start end type) - (nxml-debug-set-inside start end) - (put-text-property start end 'nxml-inside type)) + (save-excursion (nth 8 (syntax-ppss pos)))) (defun nxml-inside-end (pos) "Return the end of the inside region containing POS. Return nil if the character at POS is not inside." - (if (nxml-get-inside pos) - (or (next-single-property-change pos 'nxml-inside) - (point-max)) - nil)) + (save-excursion + (let ((ppss (syntax-ppss pos))) + (when (nth 8 ppss) + (goto-char (nth 8 ppss)) + (with-syntax-table sgml-tag-syntax-table + (if (nth 3 ppss) + (progn (forward-comment 1) (point)) + (or (scan-sexps (point) 1) (point-max)))))))) (defun nxml-inside-start (pos) "Return the start of the inside region containing POS. Return nil if the character at POS is not inside." - (if (nxml-get-inside pos) - (or (previous-single-property-change (1+ pos) 'nxml-inside) - (point-min)) - nil)) + (save-excursion (nth 8 (syntax-ppss pos)))) ;;; Change management -(defun nxml-scan-after-change (start end) - "Restore `nxml-scan-end' invariants after a change. -The change happened between START and END. -Return position after which lexical state is unchanged. -END must be > `nxml-prolog-end'. START must be outside -any “inside” regions and at the beginning of a token." - (if (>= start nxml-scan-end) - nxml-scan-end - (let ((inside-remove-start start) - xmltok-errors) - (while (or (when (xmltok-forward-special (min end nxml-scan-end)) - (when (memq xmltok-type - '(comment - cdata-section - processing-instruction)) - (nxml-clear-inside inside-remove-start - (1+ xmltok-start)) - (nxml-set-inside (1+ xmltok-start) - (point) - xmltok-type) - (setq inside-remove-start (point))) - (if (< (point) (min end nxml-scan-end)) - t - (setq end (point)) - nil)) - ;; The end of the change was inside but is now outside. - ;; Imagine something really weird like - ;; - ;; and suppose we deleted " end nxml-scan-end) - (set-marker nxml-scan-end end)) - end)) - ;; n-s-p only called from nxml-mode.el, where this variable is defined. (defvar nxml-prolog-regions) @@ -169,10 +108,7 @@ any “inside” regions and at the beginning of a token." (let (xmltok-dtd xmltok-errors) (setq nxml-prolog-regions (xmltok-forward-prolog)) - (setq nxml-prolog-end (point)) - (nxml-clear-inside (point-min) nxml-prolog-end)) - (when (< nxml-scan-end nxml-prolog-end) - (set-marker nxml-scan-end nxml-prolog-end))) + (setq nxml-prolog-end (point)))) ;;; Random access parsing @@ -223,14 +159,7 @@ Sets variables like `nxml-token-after'." (defun nxml-tokenize-forward () (let (xmltok-errors) - (when (and (xmltok-forward) - (> (point) nxml-scan-end)) - (cond ((memq xmltok-type '(comment - cdata-section - processing-instruction)) - (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) (point) xmltok-type)))) - (set-marker nxml-scan-end (point))) + (xmltok-forward) xmltok-type)) (defun nxml-move-tag-backwards (bound) @@ -253,32 +182,12 @@ As a precondition, point must be >= BOUND." Leave point unmoved if it is not inside anything special." (let ((start (nxml-inside-start (point)))) (when start - (goto-char (1- start)) + (goto-char start) (when (nxml-get-inside (point)) - (error "Char before inside-start at %s had nxml-inside property %s" - (point) - (nxml-get-inside (point))))))) + (error "Char before inside-start at %s is still \"inside\"" (point)))))) (defun nxml-ensure-scan-up-to-date () - (let ((pos (point))) - (when (< nxml-scan-end pos) - (save-excursion - (goto-char nxml-scan-end) - (let (xmltok-errors) - (while (when (xmltok-forward-special pos) - (when (memq xmltok-type - '(comment - processing-instruction - cdata-section)) - (with-silent-modifications - (nxml-set-inside (1+ xmltok-start) - (point) - xmltok-type))) - (if (< (point) pos) - t - (setq pos (point)) - nil))) - (set-marker nxml-scan-end pos)))))) + (syntax-propertize (point))) ;;; Element scanning diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 14b887e..282d495 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -36,20 +36,6 @@ `(nxml-debug "%s: %S" ,name (buffer-substring-no-properties ,start ,end)))) -(defmacro nxml-debug-set-inside (start end) - (when nxml-debug - `(let ((overlay (make-overlay ,start ,end))) - (overlay-put overlay 'face '(:background "red")) - (overlay-put overlay 'nxml-inside-debug t) - (nxml-debug-change "nxml-set-inside" ,start ,end)))) - -(defmacro nxml-debug-clear-inside (start end) - (when nxml-debug - `(cl-loop for overlay in (overlays-in ,start ,end) - if (overlay-get overlay 'nxml-inside-debug) - do (delete-overlay overlay) - finally (nxml-debug-change "nxml-clear-inside" ,start ,end)))) - (defun nxml-make-namespace (str) "Return a symbol for the namespace URI STR. STR must be a string. If STR is the empty string, return nil. diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 93d47c1..f12905a 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -34,10 +34,7 @@ ;; preceding part of the instance. This allows the instance to be ;; parsed incrementally. The main entry point is `xmltok-forward': ;; this can be called at any point in the instance provided it is -;; between tokens. The other entry point is `xmltok-forward-special' -;; which skips over tokens other comments, processing instructions or -;; CDATA sections (i.e. the constructs in an instance that can contain -;; less than signs that don't start a token). +;; between tokens. ;; ;; This is a non-validating XML 1.0 processor. It does not resolve ;; parameter entities (including the external DTD subset) and it does @@ -307,18 +304,6 @@ and VALUE-END, otherwise a STRING giving the value." (goto-char (point-max)) (setq xmltok-type 'data))))) -(defun xmltok-forward-special (bound) - "Scan forward past the first special token starting at or after point. -Return nil if there is no special token that starts before BOUND. -CDATA sections, processing instructions and comments (and indeed -anything starting with < following by ? or !) count as special. -Return the type of the token." - (when (re-search-forward "<[?!]" (1+ bound) t) - (setq xmltok-start (match-beginning 0)) - (goto-char (1+ xmltok-start)) - (let ((case-fold-search nil)) - (xmltok-scan-after-lt)))) - (eval-when-compile ;; A symbolic regexp is represented by a list whose CAR is the string @@ -738,11 +723,10 @@ Return the type of the token." (setq xmltok-type 'processing-instruction)) (defun xmltok-scan-after-comment-open () - (let (found--) - (while (and (setq found-- (re-search-forward "--\\(>\\)?" nil 'move)) - (not (match-end 1))) - (xmltok-add-error "`--' not followed by `>'" (match-beginning 0))) - (setq xmltok-type 'comment))) + (while (and (re-search-forward "--\\(>\\)?" nil 'move) + (not (match-end 1))) + (xmltok-add-error "`--' not followed by `>'" (match-beginning 0))) + (setq xmltok-type 'comment)) (defun xmltok-scan-attributes () (let ((recovering nil) commit 3dee7772f25085a1f3224b8aa05af68df2efff29 Author: Stefan Monnier Date: Sat Jan 16 14:11:11 2016 -0500 * elisp-mode.el (elisp--font-lock-flush-elisp-buffers): Fix comment diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 9e175a2..8f0b4f1 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -245,11 +245,8 @@ Blank lines separate paragraphs. Semicolons start comments. ;; Font-locking support. (defun elisp--font-lock-flush-elisp-buffers (&optional file) - ;; FIXME: Aren't we only ever called from after-load-functions? - ;; Don't flush during load unless called from after-load-functions. - ;; In that case, FILE is non-nil. It's somehow strange that - ;; load-in-progress is t when an after-load-function is called since - ;; that should run *after* the load... + ;; We're only ever called from after-load-functions, load-in-progress can + ;; still be t in case of nested loads. (when (or (not load-in-progress) file) ;; FIXME: If the loaded file did not define any macros, there shouldn't ;; be any need to font-lock-flush all the Elisp buffers. commit d7896a6f773dc4ae4e1b56c34b6708fe2bc5610a Author: Stefan Monnier Date: Sat Jan 16 14:03:29 2016 -0500 * lisp/nxml: Use standard completion; it also works for company-mode * lisp/nxml/nxml-mode.el (nxml-complete): Obsolete. (nxml-completion-at-point-function): Remove. (nxml-mode): Don't set completion-at-point-functions. * lisp/nxml/rng-nxml.el (rng-nxml-mode-init): Set it here instead. (rng-completion-at-point): Rename from rng-complete and mark it non-interactive. It is now to be used as completion-at-point-function. (rng-complete-tag, rng-complete-end-tag, rng-complete-attribute-name) (rng-complete-attribute-value): Don't perform completion, but return completion data instead. (rng-complete-qname-function, rng-generate-qname-list): Add a few arguments, previously passed via dynamic coping. (rng-strings-to-completion-table): Rename from rng-strings-to-completion-alist. Don't return an alist. Don't both sorting and uniquifying. * lisp/nxml/rng-util.el (rng-complete-before-point): Delete function. (rng-completion-exact-p, rng-quote-string): Delete functions. * lisp/nxml/rng-valid.el (rng-recover-start-tag-open) (rng-missing-attributes-message, rng-missing-element-message) (rng-mark-missing-end-tags): Use explicit ".." in formats rather than calling rng-quote-string everywhere. diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index b7a4e2e..c6600b1 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -535,8 +535,6 @@ Many aspects this mode can be customized using (nxml-clear-inside (point-min) (point-max)) (nxml-with-invisible-motion (nxml-scan-prolog))))) - (add-hook 'completion-at-point-functions - #'nxml-completion-at-point-function nil t) (setq-local syntax-propertize-function #'nxml-after-change) (add-hook 'change-major-mode-hook #'nxml-cleanup nil t) @@ -557,7 +555,6 @@ Many aspects this mode can be customized using t ; keywords-only; we highlight comments and strings here nil ; font-lock-keywords-case-fold-search. XML is case sensitive nil ; no special syntax table - nil ; no automatic syntactic fontification (font-lock-extend-region-functions . (nxml-extend-region)) (jit-lock-contextually . t) (font-lock-unfontify-region-function . nxml-unfontify-region))) @@ -1577,30 +1574,7 @@ of the line. This expects the xmltok-* variables to be set up as by (t (back-to-indentation))) (current-column)) -;;; Completion - -(defun nxml-complete () - "Perform completion on the symbol preceding point. - -Inserts as many characters as can be completed. However, if not even -one character can be completed, then a buffer with the possibilities -is popped up and the symbol is read from the minibuffer with -completion. If the symbol is complete, then any characters that must -follow the symbol are also inserted. - -The name space used for completion and what is treated as a symbol -depends on the context. The contexts in which completion is performed -depend on `nxml-completion-hook'." - (interactive) - (unless (run-hook-with-args-until-success 'nxml-completion-hook) - ;; Eventually we will complete on entity names here. - (ding) - (message "Cannot complete in this context"))) - -(defun nxml-completion-at-point-function () - "Call `nxml-complete' to perform completion at point." - (when nxml-bind-meta-tab-to-complete-flag - #'nxml-complete)) +(define-obsolete-function-alias 'nxml-complete #'completion-at-point "26.1") ;;; Movement diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index 467f7af..954a1eb 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -111,25 +111,15 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." 'append) (cond (rng-nxml-auto-validate-flag (rng-validate-mode 1) - (add-hook 'nxml-completion-hook #'rng-complete nil t) + (add-hook 'completion-at-point-functions #'rng-completion-at-point nil t) (add-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p nil t)) (t (rng-validate-mode 0) - (remove-hook 'nxml-completion-hook #'rng-complete t) + (remove-hook 'completion-at-point-functions #'rng-completion-at-point t) (remove-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p t)))) -(defvar rng-tag-history nil) -(defvar rng-attribute-name-history nil) -(defvar rng-attribute-value-history nil) - -(defvar rng-complete-target-names nil) -(defvar rng-complete-name-attribute-flag nil) -(defvar rng-complete-extra-strings nil) - -(defun rng-complete () - "Complete the string before point using the current schema. -Return non-nil if in a context it understands." - (interactive) +(defun rng-completion-at-point () + "Return completion data for the string before point using the current schema." (and rng-validate-mode (let ((lt-pos (save-excursion (search-backward "<" nil t))) xmltok-dtd) @@ -149,53 +139,48 @@ Return non-nil if in a context it understands." t)) (defun rng-complete-tag (lt-pos) - (let (rng-complete-extra-strings) - (when (and (= lt-pos (1- (point))) - rng-complete-end-tags-after-< - rng-open-elements - (not (eq (car rng-open-elements) t)) - (or rng-collecting-text - (rng-match-save - (rng-match-end-tag)))) - (setq rng-complete-extra-strings - (cons (concat "/" - (if (caar rng-open-elements) - (concat (caar rng-open-elements) - ":" - (cdar rng-open-elements)) - (cdar rng-open-elements))) - rng-complete-extra-strings))) + (let ((extra-strings + (when (and (= lt-pos (1- (point))) + rng-complete-end-tags-after-< + rng-open-elements + (not (eq (car rng-open-elements) t)) + (or rng-collecting-text + (rng-match-save + (rng-match-end-tag)))) + (list (concat "/" + (if (caar rng-open-elements) + (concat (caar rng-open-elements) + ":" + (cdar rng-open-elements)) + (cdar rng-open-elements))))))) (when (save-excursion (re-search-backward rng-in-start-tag-name-regex lt-pos t)) (and rng-collecting-text (rng-flush-text)) - (let ((completion - (let ((rng-complete-target-names - (rng-match-possible-start-tag-names)) - (rng-complete-name-attribute-flag nil)) - (rng-complete-before-point (1+ lt-pos) - 'rng-complete-qname-function - "Tag: " - nil - 'rng-tag-history))) - name) - (when completion - (cond ((rng-qname-p completion) - (setq name (rng-expand-qname completion - t - 'rng-start-tag-expand-recover)) - (when (and name - (rng-match-start-tag-open name) - (or (not (rng-match-start-tag-close)) - ;; need a namespace decl on the root element - (and (car name) - (not rng-open-elements)))) - ;; attributes are required - (insert " "))) - ((member completion rng-complete-extra-strings) - (insert ">"))))) - t))) + (let ((target-names (rng-match-possible-start-tag-names))) + `(,(1+ lt-pos) + ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point)) + ,(apply-partially #'rng-complete-qname-function + target-names nil extra-strings) + :exit-function + ,(lambda (completion status) + (cond + ((not (eq status 'finished)) nil) + ((rng-qname-p completion) + (let ((name (rng-expand-qname completion + t + #'rng-start-tag-expand-recover))) + (when (and name + (rng-match-start-tag-open name) + (or (not (rng-match-start-tag-close)) + ;; need a namespace decl on the root element + (and (car name) + (not rng-open-elements)))) + ;; attributes are required + (insert " ")))) + ((member completion extra-strings) + (insert ">"))))))))) (defconst rng-in-end-tag-name-regex (replace-regexp-in-string @@ -220,29 +205,18 @@ Return non-nil if in a context it understands." (concat (caar rng-open-elements) ":" (cdar rng-open-elements)) - (cdar rng-open-elements))) - (end-tag-name - (buffer-substring-no-properties (+ (match-beginning 0) 2) - (point)))) - (cond ((or (> (length end-tag-name) - (length start-tag-name)) - (not (string= (substring start-tag-name - 0 - (length end-tag-name)) - end-tag-name))) - (message "Expected end-tag %s" - (rng-quote-string - (concat ""))) - (ding)) - (t - (delete-region (- (point) (length end-tag-name)) - (point)) - (insert start-tag-name ">") - (when (not (or rng-collecting-text - (rng-match-end-tag))) - (message "Element %s is incomplete" - (rng-quote-string start-tag-name)))))))) - t)) + (cdar rng-open-elements)))) + `(,(+ (match-beginning 0) 2) + ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point)) + ,(list start-tag-name) ;Sole completion candidate. + :exit-function + ,(lambda (_completion status) + (when (eq status 'finished) + (unless (eq (char-after) ?>) (insert ">")) + (when (not (or rng-collecting-text + (rng-match-end-tag))) + (message "Element \"%s\" is incomplete" + start-tag-name)))))))))) (defconst rng-in-attribute-regex (replace-regexp-in-string @@ -264,22 +238,24 @@ Return non-nil if in a context it understands." rng-undeclared-prefixes) (and (rng-adjust-state-for-attribute lt-pos attribute-start) - (let ((rng-complete-target-names + (let ((target-names (rng-match-possible-attribute-names)) - (rng-complete-extra-strings + (extra-strings (mapcar (lambda (prefix) (if prefix (concat "xmlns:" prefix) "xmlns")) - rng-undeclared-prefixes)) - (rng-complete-name-attribute-flag t)) - (rng-complete-before-point attribute-start - 'rng-complete-qname-function - "Attribute: " - nil - 'rng-attribute-name-history)) - (insert "=\""))) - t)) + rng-undeclared-prefixes))) + `(,attribute-start + ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point)) + ,(apply-partially #'rng-complete-qname-function + target-names t extra-strings) + :exit-function + ,(lambda (_completion status) + (when (and (eq status 'finished) + (not (looking-at "="))) + (insert "=\"\"") + (forward-char -1))))))))) (defconst rng-in-attribute-value-regex (replace-regexp-in-string @@ -296,36 +272,33 @@ Return non-nil if in a context it understands." (defun rng-complete-attribute-value (lt-pos) (when (save-excursion (re-search-backward rng-in-attribute-value-regex lt-pos t)) - (let ((name-start (match-beginning 1)) - (name-end (match-end 1)) - (colon (match-beginning 2)) - (value-start (1+ (match-beginning 3)))) + (let* ((name-start (match-beginning 1)) + (name-end (match-end 1)) + (colon (match-beginning 2)) + (value-start (1+ (match-beginning 3))) + (exit-function + (lambda (_completion status) + (when (eq status 'finished) + (let ((delim (char-before value-start))) + (unless (eq (char-after) delim) (insert delim))))))) (and (rng-adjust-state-for-attribute lt-pos name-start) (if (string= (buffer-substring-no-properties name-start (or colon name-end)) "xmlns") - (rng-complete-before-point - value-start - (rng-strings-to-completion-alist - (rng-possible-namespace-uris - (and colon - (buffer-substring-no-properties (1+ colon) name-end)))) - "Namespace URI: " - nil - 'rng-namespace-uri-history) + `(,value-start ,(point) + ,(rng-strings-to-completion-table + (rng-possible-namespace-uris + (and colon + (buffer-substring-no-properties (1+ colon) name-end)))) + :exit-function ,exit-function) (rng-adjust-state-for-attribute-value name-start colon name-end) - (rng-complete-before-point - value-start - (rng-strings-to-completion-alist - (rng-match-possible-value-strings)) - "Value: " - nil - 'rng-attribute-value-history)) - (insert (char-before value-start)))) - t)) + `(,value-start ,(point) + ,(rng-strings-to-completion-table + (rng-match-possible-value-strings)) + :exit-function ,exit-function)))))) (defun rng-possible-namespace-uris (prefix) (let ((ns (if prefix (nxml-ns-get-prefix prefix) @@ -505,17 +478,21 @@ set `xmltok-dtd'. Returns the position of the end of the token." (and (or (not prefix) ns) (rng-match-attribute-name (cons ns local-name))))) -(defun rng-complete-qname-function (string predicate flag) - (complete-with-action flag (rng-generate-qname-list string) string predicate)) +(defun rng-complete-qname-function (candidates attributes-flag extra-strings + string predicate flag) + (complete-with-action flag + (rng-generate-qname-list + string candidates attributes-flag extra-strings) + string predicate)) -(defun rng-generate-qname-list (&optional string) +(defun rng-generate-qname-list (&optional string candidates attribute-flag extra-strings) (let ((forced-prefix (and string (string-match ":" string) (> (match-beginning 0) 0) (substring string 0 (match-beginning 0)))) - (namespaces (mapcar 'car rng-complete-target-names)) + (namespaces (mapcar #'car candidates)) ns-prefixes-alist ns-prefixes iter ns prefer) (while namespaces (setq ns (car namespaces)) @@ -523,7 +500,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (setq ns-prefixes-alist (cons (cons ns (nxml-ns-prefixes-for ns - rng-complete-name-attribute-flag)) + attribute-flag)) ns-prefixes-alist))) (setq namespaces (delq ns (cdr namespaces)))) (setq iter ns-prefixes-alist) @@ -543,12 +520,12 @@ set `xmltok-dtd'. Returns the position of the end of the token." (setcdr ns-prefixes (list prefer))) ;; Unless it's an attribute with a non-nil namespace, ;; allow no prefix for this namespace. - (unless rng-complete-name-attribute-flag + (unless attribute-flag (setcdr ns-prefixes (cons nil (cdr ns-prefixes)))))) (setq iter (cdr iter))) (rng-uniquify-equal (sort (apply #'append - (cons rng-complete-extra-strings + (cons extra-strings (mapcar (lambda (name) (if (car name) (mapcar (lambda (prefix) @@ -560,7 +537,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (cdr (assoc (car name) ns-prefixes-alist))) (list (cdr name)))) - rng-complete-target-names))) + candidates))) 'string<)))) (defun rng-get-preferred-unused-prefix (ns) @@ -579,10 +556,8 @@ set `xmltok-dtd'. Returns the position of the end of the token." nil)))) prefix)) -(defun rng-strings-to-completion-alist (strings) - (mapcar (lambda (s) (cons s s)) - (rng-uniquify-equal (sort (mapcar #'rng-escape-string strings) - 'string<)))) +(defun rng-strings-to-completion-table (strings) + (mapcar #'rng-escape-string strings)) (provide 'rng-nxml) diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el index 4c14e2b..c5d4b65 100644 --- a/lisp/nxml/rng-util.el +++ b/lisp/nxml/rng-util.el @@ -82,69 +82,6 @@ LIST is not modified." (cons item nil)))))))) list))) -(defun rng-complete-before-point (start table prompt &optional predicate hist) - "Complete text between START and point. -Replaces the text between START and point with a string chosen using a -completion table and, when needed, input read from the user with the -minibuffer. -Returns the new string if either a complete and unique completion was -determined automatically or input was read from the user. Otherwise, -returns nil. -TABLE is an alist, a symbol bound to a function or an obarray as with -the function `completing-read'. -PROMPT is the string to prompt with if user input is needed. -PREDICATE is nil or a function as with `completing-read'. -HIST, if non-nil, specifies a history list as with `completing-read'." - (let* ((orig (buffer-substring-no-properties start (point))) - (completion (try-completion orig table predicate))) - (cond ((not completion) - (if (string= orig "") - (message "No completions available") - (message "No completion for %s" (rng-quote-string orig))) - (ding) - nil) - ((eq completion t) orig) - ((not (string= completion orig)) - (delete-region start (point)) - (insert completion) - (cond ((not (rng-completion-exact-p completion table predicate)) - (message "Incomplete") - nil) - ((eq (try-completion completion table predicate) t) - completion) - (t - (message "Complete but not unique") - nil))) - (t - (setq completion - (let ((saved-minibuffer-setup-hook - (default-value 'minibuffer-setup-hook))) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help - t) - (unwind-protect - (completing-read prompt - table - predicate - nil - orig - hist) - (setq-default minibuffer-setup-hook - saved-minibuffer-setup-hook)))) - (delete-region start (point)) - (insert completion) - completion)))) - -(defun rng-completion-exact-p (string table predicate) - (cond ((symbolp table) - (funcall table string predicate 'lambda)) - ((vectorp table) - (intern-soft string table)) - (t (assoc string table)))) - -(defun rng-quote-string (s) - (concat "\"" s "\"")) - (defun rng-escape-string (s) (replace-regexp-in-string "[&\"<>]" (lambda (match) diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 9b0b4df..946bf79 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -1138,9 +1138,8 @@ as empty-element." (rng-match-start-tag-open required) (rng-match-after) (rng-match-start-tag-open name)) - (rng-mark-invalid (concat "Missing element " - (rng-quote-string - (rng-name-to-string required))) + (rng-mark-invalid (format "Missing element \"%s\"" + (rng-name-to-string required)) xmltok-start (1+ xmltok-start))) ((and (rng-match-optionalize-elements) @@ -1177,16 +1176,14 @@ as empty-element." (cond ((not required-attributes) "Required attributes missing") ((not (cdr required-attributes)) - (concat "Missing attribute " - (rng-quote-string - (rng-name-to-string (car required-attributes) t)))) + (format "Missing attribute \"%s\"" + (rng-name-to-string (car required-attributes) t))) (t - (concat "Missing attributes " + (format "Missing attributes \"%s\"" (mapconcat (lambda (nm) - (rng-quote-string - (rng-name-to-string nm t))) + (rng-name-to-string nm t)) required-attributes - ", ")))))) + "\", \"")))))) (defun rng-process-end-tag (&optional partial) (cond ((not rng-open-elements) @@ -1229,8 +1226,7 @@ as empty-element." (defun rng-missing-element-message () (let ((element (rng-match-required-element-name))) (if element - (concat "Missing element " - (rng-quote-string (rng-name-to-string element))) + (format "Missing element \"%s\"" (rng-name-to-string element)) "Required child elements missing"))) (defun rng-recover-mismatched-end-tag () @@ -1258,17 +1254,16 @@ as empty-element." (defun rng-mark-missing-end-tags (missing) (rng-mark-not-well-formed - (format "Missing end-tag%s %s" + (format "Missing end-tag%s \"%s\"" (if (null (cdr missing)) "" "s") (mapconcat (lambda (name) - (rng-quote-string - (if (car name) - (concat (car name) - ":" - (cdr name)) - (cdr name)))) + (if (car name) + (concat (car name) + ":" + (cdr name)) + (cdr name))) missing - ", ")) + "\", \"")) xmltok-start (+ xmltok-start 2))) commit d10982a91ac2b93bf9a375e00d676a25f90b885a Author: Stefan Monnier Date: Sat Jan 16 10:43:19 2016 -0500 Use sgml-electric-tag-pair-mode also in nxml-mode * lisp/nxml/rng-nxml.el: Require sgml-mode. (rng-nxml-easy-menu): Add entry for sgml-electric-tag-pair-mode. (rng-complete-qname-function): Use complete-with-action. * lisp/textmodes/sgml-mode.el (sgml-electric-tag-pair-before-change-function): Let-bind forward-sexp-function, since nxml-mode binds it to something incompatible. * lisp/nxml/nxml-mode.el: Use setq-local and defvar-local. diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index db60750..b7a4e2e 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -26,9 +26,6 @@ ;;; Code: -(when (featurep 'mucs) - (error "nxml-mode is not compatible with Mule-UCS")) - (eval-when-compile (require 'cl-lib)) (require 'xmltok) @@ -339,22 +336,19 @@ The delimiters are ." ;;; Global variables -(defvar nxml-parent-document nil +(defvar-local nxml-parent-document nil "The parent document for a part of a modular document. Use `nxml-parent-document-set' to set it.") -(make-variable-buffer-local 'nxml-parent-document) (put 'nxml-parent-document 'safe-local-variable 'stringp) -(defvar nxml-prolog-regions nil +(defvar-local nxml-prolog-regions nil "List of regions in the prolog to be fontified. See the function `xmltok-forward-prolog' for more information.") -(make-variable-buffer-local 'nxml-prolog-regions) -(defvar nxml-degraded nil +(defvar-local nxml-degraded nil "Non-nil if currently operating in degraded mode. Degraded mode is enabled when an internal error is encountered in the fontification or after-change functions.") -(make-variable-buffer-local 'nxml-degraded) (defvar nxml-completion-hook nil "Hook run by `nxml-complete'. @@ -372,13 +366,12 @@ one of the functions returns nil.") (defvar nxml-end-tag-indent-scan-distance 4000 "Maximum distance from point to scan backwards when indenting end-tag.") -(defvar nxml-char-ref-extra-display t +(defvar-local nxml-char-ref-extra-display t "Non-nil means display extra information for character references. The extra information consists of a tooltip with the character name and, if `nxml-char-ref-display-glyph-flag' is non-nil, a glyph corresponding to the referenced character following the character reference.") -(make-variable-buffer-local 'nxml-char-ref-extra-display) (defvar nxml-mode-map (let ((map (make-sparse-keymap))) @@ -516,35 +509,24 @@ Many aspects this mode can be customized using ;; FIXME: Use the fact that we're parsing the document already ;; rather than using regex-based filtering. (setq-local tildify-foreach-region-function - (apply-partially 'tildify-foreach-ignore-environments + (apply-partially #'tildify-foreach-ignore-environments '(("") ("<" . ">")))) - (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) + (setq-local mode-line-process '((nxml-degraded "/degraded"))) ;; We'll determine the fill prefix ourselves - (make-local-variable 'adaptive-fill-mode) - (setq adaptive-fill-mode nil) - (make-local-variable 'forward-sexp-function) - (setq forward-sexp-function 'nxml-forward-balanced-item) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'nxml-indent-line) - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'nxml-do-fill-paragraph) + (setq-local adaptive-fill-mode nil) + (setq-local forward-sexp-function #'nxml-forward-balanced-item) + (setq-local indent-line-function #'nxml-indent-line) + (setq-local fill-paragraph-function #'nxml-do-fill-paragraph) ;; Comment support ;; This doesn't seem to work too well; ;; I think we should probably roll our own nxml-comment-dwim function. - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'nxml-indent-line) - (make-local-variable 'comment-start) - (setq comment-start "") - (make-local-variable 'comment-end-skip) - (setq comment-end-skip "[ \t\r\n]*-->") - (make-local-variable 'comment-line-break-function) - (setq comment-line-break-function 'nxml-newline-and-indent) - (setq-local comment-quote-nested-function 'nxml-comment-quote-nested) - (use-local-map nxml-mode-map) + (setq-local comment-indent-function #'nxml-indent-line) + (setq-local comment-start "") + (setq-local comment-end-skip "[ \t\r\n]*-->") + (setq-local comment-line-break-function #'nxml-newline-and-indent) + (setq-local comment-quote-nested-function #'nxml-comment-quote-nested) (save-excursion (save-restriction (widen) @@ -556,13 +538,13 @@ Many aspects this mode can be customized using (add-hook 'completion-at-point-functions #'nxml-completion-at-point-function nil t) (setq-local syntax-propertize-function #'nxml-after-change) - (add-hook 'change-major-mode-hook 'nxml-cleanup nil t) + (add-hook 'change-major-mode-hook #'nxml-cleanup nil t) ;; Emacs 23 handles the encoding attribute on the xml declaration ;; transparently to nxml-mode, so there is no longer a need for the below ;; hook. The hook also had the drawback of overriding explicit user ;; instruction to save as some encoding other than utf-8. - ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save) + ;;(add-hook 'write-contents-hooks #'nxml-prepare-to-save) (when (not (and (buffer-file-name) (file-exists-p (buffer-file-name)))) (when (and nxml-default-buffer-file-coding-system (not (local-variable-p 'buffer-file-coding-system))) @@ -592,7 +574,7 @@ Many aspects this mode can be customized using (with-silent-modifications (nxml-with-invisible-motion (remove-text-properties (point-min) (point-max) '(face))))) - (remove-hook 'change-major-mode-hook 'nxml-cleanup t)) + (remove-hook 'change-major-mode-hook #'nxml-cleanup t)) (defun nxml-degrade (context err) (message "Internal nXML mode error in %s (%s), degrading" @@ -1670,7 +1652,7 @@ single name. A character reference contains a character number." (t end))))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err))))) + (apply #'error (cddr err))))) (defun nxml-backward-single-balanced-item () (condition-case err @@ -1692,7 +1674,7 @@ single name. A character reference contains a character number." (t xmltok-start))))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err))))) + (apply #'error (cddr err))))) (defun nxml-scan-forward-within (end) (setq end (- end (nxml-end-delimiter-length xmltok-type))) @@ -1876,7 +1858,7 @@ single name. A character reference contains a character number." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-backward-up-element (&optional arg) (interactive "p") @@ -1905,7 +1887,7 @@ single name. A character reference contains a character number." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-down-element (&optional arg) "Move forward down into the content of an element. @@ -1970,7 +1952,7 @@ Negative ARG means move backward." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-backward-element (&optional arg) "Move backward over one element. @@ -1992,7 +1974,7 @@ Negative ARG means move forward." (setq arg (1- arg))) (nxml-scan-error (goto-char (cadr err)) - (apply 'error (cddr err)))))) + (apply #'error (cddr err)))))) (defun nxml-mark-token-after () (interactive) diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index 85e4bf3..467f7af 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -33,6 +33,7 @@ (require 'rng-valid) (require 'nxml-mode) (require 'rng-loc) +(require 'sgml-mode) (defcustom rng-nxml-auto-validate-flag t "Non-nil means automatically turn on validation with nxml-mode." @@ -65,6 +66,9 @@ Complete on start-tag names regardless.") ["Validation" rng-validate-mode :style toggle :selected rng-validate-mode] + ["Electric Pairs" sgml-electric-tag-pair-mode + :style toggle + :selected sgml-electric-tag-pair-mode] "---" ("Set Schema" ["Automatically" rng-auto-set-schema] @@ -107,12 +111,12 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." 'append) (cond (rng-nxml-auto-validate-flag (rng-validate-mode 1) - (add-hook 'nxml-completion-hook 'rng-complete nil t) - (add-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p nil t)) + (add-hook 'nxml-completion-hook #'rng-complete nil t) + (add-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p nil t)) (t (rng-validate-mode 0) - (remove-hook 'nxml-completion-hook 'rng-complete t) - (remove-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p t)))) + (remove-hook 'nxml-completion-hook #'rng-complete t) + (remove-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p t)))) (defvar rng-tag-history nil) (defvar rng-attribute-name-history nil) @@ -328,7 +332,7 @@ Return non-nil if in a context it understands." (nxml-ns-get-default)))) (if (and ns (memq prefix (nxml-ns-changed-prefixes))) (list (nxml-namespace-name ns)) - (mapcar 'nxml-namespace-name + (mapcar #'nxml-namespace-name (delq nxml-xml-namespace-uri (rng-match-possible-namespace-uris)))))) @@ -502,14 +506,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (rng-match-attribute-name (cons ns local-name))))) (defun rng-complete-qname-function (string predicate flag) - (let ((alist (mapcar (lambda (name) (cons name nil)) - (rng-generate-qname-list string)))) - (cond ((not flag) - (try-completion string alist predicate)) - ((eq flag t) - (all-completions string alist predicate)) - ((eq flag 'lambda) - (and (assoc string alist) t))))) + (complete-with-action flag (rng-generate-qname-list string) string predicate)) (defun rng-generate-qname-list (&optional string) (let ((forced-prefix (and string @@ -550,7 +547,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (setcdr ns-prefixes (cons nil (cdr ns-prefixes)))))) (setq iter (cdr iter))) (rng-uniquify-equal - (sort (apply 'append + (sort (apply #'append (cons rng-complete-extra-strings (mapcar (lambda (name) (if (car name) @@ -584,7 +581,7 @@ set `xmltok-dtd'. Returns the position of the end of the token." (defun rng-strings-to-completion-alist (strings) (mapcar (lambda (s) (cons s s)) - (rng-uniquify-equal (sort (mapcar 'rng-escape-string strings) + (rng-uniquify-equal (sort (mapcar #'rng-escape-string strings) 'string<)))) (provide 'rng-nxml) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 98a01e8..f729760 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -862,11 +862,12 @@ Return non-nil if we skipped over matched tags." (if endp (when (sgml-skip-tag-backward 1) (forward-char 1) t) (with-syntax-table sgml-tag-syntax-table - (up-list -1) - (when (sgml-skip-tag-forward 1) - (backward-sexp 1) - (forward-char 2) - t)))) + (let ((forward-sexp-function nil)) + (up-list -1) + (when (sgml-skip-tag-forward 1) + (backward-sexp 1) + (forward-char 2) + t))))) (clones (get-char-property (point) 'text-clones))) (when (and match (/= cl-end cl-start)