diff options
Diffstat (limited to 'lisp/textmodes/sgml-mode.el')
| -rw-r--r-- | lisp/textmodes/sgml-mode.el | 131 |
1 files changed, 69 insertions, 62 deletions
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 50b2077ef4f..9e3be99af14 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -46,8 +46,7 @@ (defcustom sgml-basic-offset 2 "Specifies the basic indentation level for `sgml-indent-line'." - :type 'integer - :group 'sgml) + :type 'integer) (defcustom sgml-attribute-offset 0 "Specifies a delta for attribute indentation in `sgml-indent-line'. @@ -65,16 +64,16 @@ When 2, attribute indentation looks like this: </element>" :version "25.1" :type 'integer - :safe 'integerp - :group 'sgml) + :safe 'integerp) (defcustom sgml-xml-mode nil "When non-nil, tag insertion functions will be XML-compliant. It is set to be buffer-local when the file has a DOCTYPE or an XML declaration." :type 'boolean - :version "22.1" - :group 'sgml) + :version "22.1") + +(defvaralias 'sgml-transformation 'sgml-transformation-function) (defcustom sgml-transformation-function 'identity "Default value for `skeleton-transformation-function' in SGML mode." @@ -87,17 +86,14 @@ a DOCTYPE or an XML declaration." (and (derived-mode-p 'sgml-mode) (not sgml-xml-mode) (setq skeleton-transformation-function val)))) - (buffer-list))) - :group 'sgml) + (buffer-list)))) (put 'sgml-transformation-function 'variable-interactive "aTransformation function: ") -(defvaralias 'sgml-transformation 'sgml-transformation-function) (defcustom sgml-mode-hook nil "Hook run by command `sgml-mode'. `text-mode-hook' is run first." - :group 'sgml :type 'hook) ;; As long as Emacs's syntax can't be complemented with predicates to context @@ -210,8 +206,7 @@ This takes effect when first loading the `sgml-mode' library.") (defcustom sgml-name-8bit-mode nil "When non-nil, insert non-ASCII characters as named entities." - :type 'boolean - :group 'sgml) + :type 'boolean) (defvar sgml-char-names [nil nil nil nil nil nil nil nil @@ -281,8 +276,7 @@ Currently, only Latin-1 characters are supported.") The file name of current buffer file name will be appended to this, separated by a space." :type 'string - :version "21.1" - :group 'sgml) + :version "21.1") (defvar sgml-saved-validate-command nil "The command last used to validate in this buffer.") @@ -291,8 +285,7 @@ separated by a space." ;; so use a small distance here. (defcustom sgml-slash-distance 1000 "If non-nil, is the maximum distance to search for matching `/'." - :type '(choice (const nil) integer) - :group 'sgml) + :type '(choice (const nil) integer)) (defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*") (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*") @@ -304,8 +297,7 @@ Any terminating `>' or `/' is not matched.") (defface sgml-namespace '((t (:inherit font-lock-builtin-face))) - "`sgml-mode' face used to highlight the namespace part of identifiers." - :group 'sgml) + "`sgml-mode' face used to highlight the namespace part of identifiers.") (defvar sgml-namespace-face 'sgml-namespace) ;; internal @@ -351,12 +343,21 @@ Any terminating `>' or `/' is not matched.") ("--[ \t\n]*\\(>\\)" (1 "> b")) ("\\(<\\)[?!]" (1 (prog1 "|>" (sgml-syntax-propertize-inside end)))) - ;; Double quotes outside of tags should not introduce strings. - ;; Be careful to call `syntax-ppss' on a position before the one we're - ;; going to change, so as not to need to flush the data we just computed. - ("\"" (0 (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) - (goto-char (match-end 0))) - (string-to-syntax "."))))))) + ;; Double quotes outside of tags should not introduce strings which end up + ;; hiding tags. We used to test every double quote and mark it as "." + ;; if it's outside of tags, but there are too many double quotes and + ;; the resulting number of calls to syntax-ppss made it too slow + ;; (bug#33887), so we're now careful to leave alone any pair + ;; of quotes that doesn't hold a < or > char, which is the vast majority. + ("\\(\"\\)[^\"<>]*[<>\"]" + (1 (unless (eq ?\" (char-before)) + ;; Be careful to call `syntax-ppss' on a position before the one + ;; we're going to change, so as not to need to flush the data we + ;; just computed. + (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) + (goto-char (1- (match-end 0)))) + (string-to-syntax "."))))) + ))) (defun sgml-syntax-propertize (start end) "Syntactic keywords for `sgml-mode'." @@ -420,8 +421,7 @@ The attribute alist is made up as ATTRIBUTERULE is a list of optionally t (no value when no input) followed by an optional alist of possible values." :type '(repeat (cons (string :tag "Tag Name") - (repeat :tag "Tag Rule" sexp))) - :group 'sgml) + (repeat :tag "Tag Rule" sexp)))) (put 'sgml-tag-alist 'risky-local-variable t) (defcustom sgml-tag-help @@ -433,8 +433,7 @@ an optional alist of possible values." ("!entity" . "Entity (macro) declaration")) "Alist of tag name and short description." :type '(repeat (cons (string :tag "Tag Name") - (string :tag "Description"))) - :group 'sgml) + (string :tag "Description")))) (defvar sgml-empty-tags nil "List of tags whose !ELEMENT definition says EMPTY.") @@ -460,7 +459,7 @@ an optional alist of possible values." nil t) (string-match "X\\(HT\\)?ML" (match-string 3)))))) -(defvar v2) ; free for skeleton +(with-no-warnings (defvar v2)) ; free for skeleton (defun sgml-comment-indent-new-line (&optional soft) (let ((comment-start "-- ") @@ -618,7 +617,7 @@ Behaves electrically if `sgml-quick-keys' is non-nil." (delete-char -1) (sgml-close-tag)) (t - (sgml-slash-matching arg)))) + (insert-char ?/ arg)))) (defun sgml-slash-matching (arg) "Insert `/' and display any previous matching `/'. @@ -895,7 +894,7 @@ Return non-nil if we skipped over matched tags." (condition-case err (save-excursion (goto-char end) - (skip-chars-backward "[:alnum:]-_.:") + (skip-chars-backward "-[:alnum:]_.:") (if (and ;; (<= (point) beg) ; This poses problems for downcase-word. (or (eq (char-before) ?<) (and (eq (char-before) ?/) @@ -903,7 +902,7 @@ Return non-nil if we skipped over matched tags." (null (get-char-property (point) 'text-clones))) (let* ((endp (eq (char-before) ?/)) (cl-start (point)) - (cl-end (progn (skip-chars-forward "[:alnum:]-_.:") (point))) + (cl-end (progn (skip-chars-forward "-[:alnum:]_.:") (point))) (match (if endp (when (sgml-skip-tag-backward 1) (forward-char 1) t) @@ -920,7 +919,8 @@ Return non-nil if we skipped over matched tags." (equal (buffer-substring cl-start cl-end) (buffer-substring (point) (save-excursion - (skip-chars-forward "[:alnum:]-_.:") + (skip-chars-forward + "-[:alnum:]_.:") (point)))) (or (not endp) (eq (char-after cl-end) ?>))) (when clones @@ -940,9 +940,6 @@ Return non-nil if we skipped over matched tags." (define-minor-mode sgml-electric-tag-pair-mode "Toggle SGML Electric Tag Pair mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. SGML Electric Tag Pair mode is a buffer-local minor mode for use with `sgml-mode' and related major modes. When enabled, editing @@ -1241,8 +1238,11 @@ See `sgml-tag-alist' for info about attribute rules." (defun sgml-quote (start end &optional unquotep) "Quote SGML text in region START ... END. -Only &, < and > are quoted, the rest is left untouched. -With prefix argument UNQUOTEP, unquote the region." +Only &, <, >, ' and \" characters are quoted, the rest is left +untouched. This is sufficient to use quoted text as SGML argument. + +With prefix argument UNQUOTEP, unquote the region. All numeric entities, +\"amp\", \"lt\", \"gt\" and \"quot\" named entities are unquoted." (interactive "r\nP") (save-restriction (narrow-to-region start end) @@ -1250,14 +1250,23 @@ With prefix argument UNQUOTEP, unquote the region." (if unquotep ;; FIXME: We should unquote other named character references as well. (while (re-search-forward - "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]" + "\\(&\\(amp\\|quot\\|lt\\|gt\\|#\\([0-9]+\\|[xX][0-9a-fA-F]+\\)\\)\\)\\([][<>&;\n\t \"%!'(),/=?]\\|$\\)" nil t) - (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t - nil (if (eq (char-before (match-end 0)) ?\;) 0 1))) - (while (re-search-forward "[&<>]" nil t) + (replace-match + (string + (or (cdr (assq (char-after (match-beginning 2)) + '((?a . ?&) (?q . ?\") (?l . ?<) (?g . ?>)))) + (let ((num (match-string 3))) + (if (or (eq ?x (aref num 0)) (eq ?X (aref num 0))) + (string-to-number (substring num 1) 16) + (string-to-number num 10))))) + t t nil (if (eq (char-before (match-end 0)) ?\;) 0 1))) + (while (re-search-forward "[&<>\"']" nil t) (replace-match (cdr (assq (char-before) '((?& . "&") (?< . "<") - (?> . ">")))) + (?> . ">") + (?\" . """) + (?' . "'")))) t t))))) (defun sgml-pretty-print (beg end) @@ -1514,12 +1523,12 @@ Depending on context, inserts a matching close-tag, or closes the current start-tag or the current comment or the current cdata, ..." (interactive) (pcase (car (sgml-lexical-context)) - (`comment (insert " -->")) - (`cdata (insert "]]>")) - (`pi (insert " ?>")) - (`jsp (insert " %>")) - (`tag (insert " />")) - (`text + ('comment (insert " -->")) + ('cdata (insert "]]>")) + ('pi (insert " ?>")) + ('jsp (insert " %>")) + ('tag (insert " />")) + ('text (let ((context (save-excursion (sgml-get-context)))) (if context (progn @@ -1552,7 +1561,7 @@ LCON is the lexical context, if any." (pcase (car lcon) - (`string + ('string ;; Go back to previous non-empty line. (while (and (> (point) (cdr lcon)) (zerop (forward-line -1)) @@ -1563,7 +1572,7 @@ LCON is the lexical context, if any." (goto-char (cdr lcon)) (1+ (current-column)))) - (`comment + ('comment (let ((mark (looking-at "--"))) ;; Go back to previous non-empty line. (while (and (> (point) (cdr lcon)) @@ -1582,11 +1591,11 @@ LCON is the lexical context, if any." (current-column))) ;; We don't know how to indent it. Let's be honest about it. - (`cdata nil) + ('cdata nil) ;; We don't know how to indent it. Let's be honest about it. - (`pi nil) + ('pi nil) - (`tag + ('tag (goto-char (+ (cdr lcon) sgml-attribute-offset)) (skip-chars-forward "^ \t\n") ;Skip tag name. (skip-chars-forward " \t") @@ -1596,7 +1605,7 @@ LCON is the lexical context, if any." (goto-char (+ (cdr lcon) sgml-attribute-offset)) (+ (current-column) sgml-basic-offset))) - (`text + ('text (while (looking-at "</") (sgml-forward-sexp 1) (skip-chars-forward " \t")) @@ -1712,7 +1721,6 @@ Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)." (defcustom html-mode-hook nil "Hook run by command `html-mode'. `text-mode-hook' and `sgml-mode-hook' are run first." - :group 'sgml :type 'hook :options '(html-autoview-mode)) @@ -2232,6 +2240,9 @@ buffer's tick counter (as produced by `buffer-modified-tick'), and the CDR is the list of class names found in the buffer.") (make-variable-buffer-local 'html--buffer-ids-cache) +(declare-function libxml-parse-html-region "xml.c" + (start end &optional base-url discard-comments)) + (defun html-current-buffer-classes () "Return a list of class names used in the current buffer. The result is cached in `html--buffer-classes-cache'." @@ -2363,18 +2374,14 @@ The third `match-string' will be the used in the menu.") (define-minor-mode html-autoview-mode "Toggle viewing of HTML files on save (HTML Autoview mode). -With a prefix argument ARG, enable HTML Autoview mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. HTML Autoview mode is a buffer-local minor mode for use with `html-mode'. If enabled, saving the file automatically runs `browse-url-of-buffer' to view it." nil nil nil - :group 'sgml (if html-autoview-mode - (add-hook 'after-save-hook 'browse-url-of-buffer nil t) - (remove-hook 'after-save-hook 'browse-url-of-buffer t))) + (add-hook 'after-save-hook #'browse-url-of-buffer nil t) + (remove-hook 'after-save-hook #'browse-url-of-buffer t))) (define-skeleton html-href-anchor |