diff options
Diffstat (limited to 'lisp/textmodes/sgml-mode.el')
| -rw-r--r-- | lisp/textmodes/sgml-mode.el | 297 |
1 files changed, 262 insertions, 35 deletions
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index c9ba0a9bb54..97a11443984 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -32,6 +32,9 @@ ;;; Code: +(require 'dom) +(require 'seq) +(require 'subr-x) (eval-when-compile (require 'skeleton) (require 'cl-lib)) @@ -338,20 +341,40 @@ Any terminating `>' or `/' is not matched.") (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 "Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") -(defconst sgml-syntax-propertize-function +(defun sgml-syntax-propertize (start end) + "Syntactic keywords for `sgml-mode'." + (goto-char start) + (sgml-syntax-propertize-inside end) + (funcall (syntax-propertize-rules ;; Use the `b' style of comments to avoid interference with the -- ... -- ;; comments recognized when `sgml-specials' includes ?-. - ;; FIXME: beware of <!--> blabla <!--> !! + ;; FIXME: beware of <!--> blabla <!--> !! ("\\(<\\)!--" (1 "< b")) - ("--[ \t\n]*\\(>\\)" (1 "> b")) - ;; 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 "."))))) - "Syntactic keywords for `sgml-mode'.") + ("--[ \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 "."))))) + start end)) + +(defun sgml-syntax-propertize-inside (end) + (let ((ppss (syntax-ppss))) + (cond + ((eq (nth 3 ppss) t) + (let ((endre (save-excursion + (goto-char (nth 8 ppss)) + (cond + ((looking-at-p "<!\\[CDATA\\[") "]]>") + ((looking-at-p "<\\?") (if sgml-xml-mode "\\?>" ">")) + (t ">"))))) + (when (re-search-forward endre end 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|<")))))))) ;; internal (defvar sgml-face-tag-alist () @@ -544,7 +567,7 @@ Do \\[describe-key] on the following bindings to discover what they do. sgml-font-lock-keywords-1 sgml-font-lock-keywords-2) nil t)) - (setq-local syntax-propertize-function sgml-syntax-propertize-function) + (setq-local syntax-propertize-function #'sgml-syntax-propertize) (setq-local facemenu-add-face-function 'sgml-mode-facemenu-add-face-function) (setq-local sgml-xml-mode (sgml-xml-guess)) (unless sgml-xml-mode @@ -842,6 +865,25 @@ Return non-nil if we skipped over matched tags." (setq arg (1- arg))) return)) +(defun sgml-forward-sexp (n) + ;; This function is needed in major-modes such as nxml-mode where + ;; forward-sexp-function is used to give a more dwimish behavior to + ;; the `forward-sexp' command. + ;; Without it, we can end up with backtraces like: + ;; "get-text-property" (0xffffc0f0) + ;; "nxml-token-after" (0xffffc2ac) + ;; "nxml-forward-single-balanced-item" (0xffffc46c) + ;; "nxml-forward-balanced-item" (0xffffc61c) + ;; "forward-sexp" (0xffffc7f8) + ;; "sgml-parse-tag-backward" (0xffffc9c8) + ;; "sgml-lexical-context" (0xffffcba8) + ;; "sgml-mode-flyspell-verify" (0xffffcd74) + ;; "flyspell-word" (0xffffcf3c) + ;; "flyspell-post-command-hook" (0xffffd108) + ;; FIXME: should we also set the sgml-tag-syntax-table? + (let ((forward-sexp-function nil)) + (forward-sexp n))) + (defvar sgml-electric-tag-pair-overlays nil) (defvar sgml-electric-tag-pair-timer nil) @@ -862,11 +904,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) @@ -1066,9 +1109,9 @@ With prefix argument ARG, repeat this ARG times." ((and (eq (char-before) ?>) (or (not (eq (char-after) ?<)) (> x y))) - (backward-sexp)) + (sgml-forward-sexp -1)) ((eq (char-after y) ?<) - (forward-sexp))) + (sgml-forward-sexp 1))) (point)))) (message "Invisible tag: %s" ;; Strip properties, otherwise, the text is invisible. @@ -1235,7 +1278,7 @@ You might want to turn on `auto-fill-mode' to get better results." (unless (or ;;(looking-at "</") (progn (skip-chars-backward " \t") (bolp))) (reindent-then-newline-and-indent)) - (forward-sexp 1))) + (sgml-forward-sexp 1))) ;; (indent-region beg end) )) @@ -1281,7 +1324,7 @@ Leave point at the beginning of the tag." (let ((pos (point))) (condition-case nil ;; FIXME: This does not correctly skip over PI an CDATA tags. - (forward-sexp) + (sgml-forward-sexp 1) (scan-error ;; This < seems to be just a spurious one, let's ignore it. (goto-char pos) @@ -1315,7 +1358,7 @@ Leave point at the beginning of the tag." (with-syntax-table sgml-tag-syntax-table (goto-char tag-end) (condition-case nil - (backward-sexp) + (sgml-forward-sexp -1) (scan-error ;; This > isn't really the end of a tag. Skip it. (goto-char (1- tag-end)) @@ -1540,7 +1583,7 @@ LCON is the lexical context, if any." (`text (while (looking-at "</") - (forward-sexp 1) + (sgml-forward-sexp 1) (skip-chars-forward " \t")) (let* ((here (point)) (unclosed (and ;; (not sgml-xml-mode) @@ -1759,11 +1802,12 @@ This takes effect when first loading the library.") "Value of `sgml-display-text' for HTML mode.") -;; should code exactly HTML 3 here when that is finished (defvar html-tag-alist (let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7"))) (1-9 `(,@1-7 ("8") ("9"))) (align '(("align" ("left") ("center") ("right")))) + (ialign '(("align" ("top") ("middle") ("bottom") ("left") + ("right")))) (valign '(("top") ("middle") ("bottom") ("baseline"))) (rel '(("next") ("previous") ("parent") ("subdocument") ("made"))) (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:") @@ -1776,17 +1820,29 @@ This takes effect when first loading the library.") ("title"))) (list '((nil \n ("List item: " "<li>" str (if sgml-xml-mode "</li>") \n)))) + (shape '(("shape" ("rect") ("circle") ("poly") ("default")))) (cell `(t ,@align ("valign" ,@valign) ("colspan" ,@1-9) ("rowspan" ,@1-9) - ("nowrap" t)))) + ("nowrap" t))) + (cellhalign '(("align" ("left") ("center") ("right") + ("justify") ("char")) + ("char") ("charoff"))) + (cellvalign '(("valign" ("top") ("middle") ("bottom") + ("baseline"))))) ;; put ,-expressions first, else byte-compile chokes (as of V19.29) ;; and like this it's more efficient anyway `(("a" ,name ,@link) + ("area" t ,@shape ("coords") ("href") ("nohref" "nohref") ("alt") + ("tabindex") ("accesskey") ("onfocus") ("onblur")) ("base" t ,@href) + ("col" t ,@cellhalign ,@cellvalign ("span") ("width")) + ("colgroup" \n ,@cellhalign ,@cellvalign ("span") ("width")) ("dir" ,@list) + ("figcaption") + ("figure" \n) ("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7) ("form" (\n _ \n "<input type=\"submit\" value=\"\"" (if sgml-xml-mode " />" ">")) @@ -1798,13 +1854,28 @@ This takes effect when first loading the library.") ("h5" ,@align) ("h6" ,@align) ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align) + ("iframe" \n ,@ialign ("longdesc") ("name") ("src") + ("frameborder" ("1") ("0")) ("marginwidth") ("marginheight") + ("scrolling" ("yes") ("no") ("auto")) ("height") ("width")) ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom")) ("src") ("alt") ("width" "1") ("height" "1") ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t)) - ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name - ("type" ("text") ("password") ("checkbox") ("radio") - ("submit") ("reset")) - ("value")) + ("input" t ,name ("accept") ("alt") ("autocomplete" ("on") ("off")) + ("autofocus" t) ("checked" t) ("dirname") ("disabled" t) ("form") + ("formaction") + ("formenctype" ("application/x-www-form-urlencoded") + ("multipart/form-data") ("text/plain")) + ("formmethod" ("get") ("post")) + ("formnovalidate" t) + ("formtarget" ("_blank") ("_self") ("_parent") ("_top")) + ("height") ("inputmode") ("list") ("max") ("maxlength") ("min") + ("minlength") ("multiple" t) ("pattern") ("placeholder") + ("readonly" t) ("required" t) ("size") ("src") ("step") + ("type" ("hidden") ("text") ("search") ("tel") ("url") ("email") + ("password") ("date") ("time") ("number") ("range") ("color") + ("checkbox") ("radio") ("file") ("submit") ("image") ("reset") + ("button")) + ("value") ("width")) ("link" t ,@link) ("menu" ,@list) ("ol" ,@list ("type" ("A") ("a") ("I") ("i") ("1"))) @@ -1819,14 +1890,17 @@ This takes effect when first loading the library.") "<tr><" str ?> _ (if sgml-xml-mode (concat "<" str "></tr>")) \n)) ("border" t ,@1-9) ("width" "10") ("cellpadding")) + ("tbody" \n ,@cellhalign ,@cellvalign) ("td" ,@cell) ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9)) + ("tfoot" \n ,@cellhalign ,@cellvalign) ("th" ,@cell) + ("thead" \n ,@cellhalign ,@cellvalign) ("ul" ,@list ("type" ("disc") ("circle") ("square"))) ,@sgml-tag-alist - ("abbrev") + ("abbr") ("acronym") ("address") ("array" (nil \n @@ -1835,20 +1909,33 @@ This takes effect when first loading the library.") ("article" \n) ("aside" \n) ("au") + ("audio" \n + ("src") ("crossorigin" ("anonymous") ("use-credentials")) + ("preload" ("none") ("metadata") ("auto")) + ("autoplay" "autoplay") ("mediagroup") ("loop" "loop") + ("muted" "muted") ("controls" "controls")) ("b") + ("bdi") + ("bdo" nil ("lang") ("dir" ("ltr") ("rtl"))) ("big") ("blink") - ("blockquote" \n) + ("blockquote" \n ("cite")) ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#") ("link" "#") ("alink" "#") ("vlink" "#")) ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>"))) ("br" t ("clear" ("left") ("right"))) + ("button" nil ("name") ("value") + ("type" ("submit") ("reset") ("button")) + ("disabled" "disabled") + ("tabindex") ("accesskey") ("onfocus") ("onblur")) + ("canvas" \n ("width") ("height")) ("caption" ("valign" ("top") ("bottom"))) ("center" \n) ("cite") ("code" \n) + ("datalist" \n) ("dd" ,(not sgml-xml-mode)) - ("del") + ("del" nil ("cite") ("datetime")) ("dfn") ("div") ("dl" (nil \n @@ -1858,14 +1945,20 @@ This takes effect when first loading the library.") ("dt" (t _ (if sgml-xml-mode "</dt>") "<dd>" (if sgml-xml-mode "</dd>") \n)) ("em") + ("embed" t ("src") ("type") ("width") ("height")) + ("fieldset" \n) ("fn" "id" "fn") ;; Footnotes were deprecated in HTML 3.2 ("footer" \n) + ("frame" t ("longdesc") ("name") ("src") + ("frameborder" ("1") ("0")) ("marginwidth") ("marginheight") + ("noresize" "noresize") ("scrolling" ("yes") ("no") ("auto"))) + ("frameset" \n ("rows") ("cols") ("onload") ("onunload")) ("head" \n) ("header" \n) ("hgroup" \n) ("html" (\n "<head>\n" - "<title>" (setq str (read-input "Title: ")) "</title>\n" + "<title>" (setq str (read-string "Title: ")) "</title>\n" "</head>\n" "<body>\n<h1>" str "</h1>\n" _ "\n<address>\n<a href=\"mailto:" @@ -1874,24 +1967,49 @@ This takes effect when first loading the library.") "</body>" )) ("i") - ("ins") + ("ins" nil ("cite") ("datetime")) ("isindex" t ("action") ("prompt")) ("kbd") + ("label" nil ("for") ("accesskey") ("onfocus") ("onblur")) ("lang") + ("legend" nil ("accesskey")) ("li" ,(not sgml-xml-mode)) + ("main" \n) + ("map" \n ("name")) + ("mark") ("math" \n) + ("meta" t ("http-equiv") ("name") ("content") ("scheme")) + ("meter" nil ("value") ("min") ("max") ("low") ("high") + ("optimum")) ("nav" \n) ("nobr") + ("noframes" \n) + ("noscript" \n) + ("object" \n ("declare" "declare") ("classid") ("codebase") + ("data") ("type") ("codetype") ("archive") ("standby") + ("height") ("width") ("usemap") ("name") ("tabindex")) + ("optgroup" \n ("name") ("size") ("multiple" "multiple") + ("disabled" "disabled") ("tabindex") ("onfocus") ("onblur") + ("onchange")) ("option" t ("value") ("label") ("selected" t)) + ("output" nil ("for") ("form") ("name")) ("over" t) + ("param" t ("name") ("value") + ("valuetype" ("data") ("ref") ("object")) ("type")) ("person") ;; Tag for person's name tag deprecated in HTML 3.2 ("pre" \n) - ("q") + ("progress" nil ("value") ("max")) + ("q" nil ("cite")) ("rev") + ("rp" t) + ("rt" t) + ("ruby") ("s") ("samp") + ("script" nil ("charset") ("type") ("src") ("defer" "defer")) ("section" \n) ("small") + ("source" t ("src") ("type") ("media")) ("span" nil ("class" ("builtin") @@ -1904,39 +2022,60 @@ This takes effect when first loading the library.") ("variable-name") ("warning"))) ("strong") + ("style" \n ("type") ("media") ("title")) ("sub") + ("summary") ("sup") + ("time" nil ("datetime")) ("title") ("tr" t) + ("track" t + ("kind" ("subtitles") ("captions") ("descriptions") + ("chapters") ("metadata")) + ("src") ("srclang") ("label") ("default")) ("tt") ("u") ("var") + ("video" \n + ("src") ("crossorigin" ("anonymous") ("use-credentials")) + ("poster") ("preload" ("none") ("metadata") ("auto")) + ("autoplay" "autoplay") ("mediagroup") ("loop" "loop") + ("muted" "muted") ("controls" "controls") ("width") ("height")) ("wbr" t))) "Value of `sgml-tag-alist' for HTML mode.") (defvar html-tag-help `(,@sgml-tag-help ("a" . "Anchor of point or link elsewhere") - ("abbrev" . "Abbreviation") + ("abbr" . "Abbreviation") ("acronym" . "Acronym") ("address" . "Formatted mail address") + ("area" . "Region of an image map") ("array" . "Math array") ("article" . "An independent part of document or site") ("aside" . "Secondary content related to surrounding content (e.g. page or article)") ("au" . "Author") + ("audio" . "Sound or audio stream") ("b" . "Bold face") ("base" . "Base address for URLs") + ("bdi" . "Text isolated for bidirectional formatting") + ("bdo" . "Override text directionality") ("big" . "Font size") ("blink" . "Blinking text") ("blockquote" . "Indented quotation") ("body" . "Document body") ("box" . "Math fraction") ("br" . "Line break") + ("button" . "Clickable button") + ("canvas" . "Script generated graphics canvas") ("caption" . "Table caption") ("center" . "Centered text") ("changed" . "Change bars") ("cite" . "Citation of a document") ("code" . "Formatted source code") + ("col" . "Group of attribute specifications for table columns") + ("colgroup" . "Group of columns") + ("datalist" . "A set of predefined options") ("dd" . "Definition of term") ("del" . "Deleted text") ("dfn" . "Defining instance of a term") @@ -1946,14 +2085,19 @@ This takes effect when first loading the library.") ("dt" . "Term to be defined") ("em" . "Emphasized") ("embed" . "Embedded data in foreign format") + ("fieldset" . "Group of related controls and labels") ("fig" . "Figure") ("figa" . "Figure anchor") + ("figcaption" . "Caption for a figure") ("figd" . "Figure description") ("figt" . "Figure text") + ("figure" . "Self-contained content, often with a caption") ("fn" . "Footnote") ;; No one supports special footnote rendering. ("font" . "Font size") ("footer" . "Footer of a section") ("form" . "Form with input fields") + ("frame" . "Frame in which another HTML document can be displayed") + ("frameset" . "Container for frames") ("group" . "Document grouping") ("h1" . "Most important section headline") ("h2" . "Important section headline") @@ -1967,50 +2111,78 @@ This takes effect when first loading the library.") ("hr" . "Horizontal rule") ("html" . "HTML Document") ("i" . "Italic face") + ("iframe" . "Inline frame with a nested browsing context") ("img" . "Graphic image") ("input" . "Form input field") ("ins" . "Inserted text") ("isindex" . "Input field for index search") ("kbd" . "Keyboard example face") + ("label" . "Caption for a user interface item") ("lang" . "Natural language") + ("legend" . "Caption for a fieldset") ("li" . "List item") ("link" . "Link relationship") + ("main" . "Main content of the document body") + ("map" . "Image map (a clickable link area") + ("mark" . "Highlighted text") ("math" . "Math formula") ("menu" . "List of commands") + ("meta" . "Document properties") + ("meter" . "Scalar measurement within a known range") ("mh" . "Form mail header") ("nav" . "Group of navigational links") ("nextid" . "Allocate new id") ("nobr" . "Text without line break") + ("noframes" . "Content for user agents that don't support frames") + ("noscript" . "Alternate content for when a script isn't executed") + ("object" . "External resource") ("ol" . "Ordered list") + ("optgroup" . "Group of options") ("option" . "Selection list item") + ("output" . "Result of a calculation or user action") ("over" . "Math fraction rule") ("p" . "Paragraph start") ("panel" . "Floating panel") + ("param" . "Parameters for an object") ("person" . "Person's name") ("pre" . "Preformatted fixed width text") + ("progress" . "Completion progress of a task") ("q" . "Quotation") ("rev" . "Reverse video") + ("rp" . "Fallback text for when ruby annotations aren't supported") + ("rt" . "Ruby text component of a ruby annotation") + ("ruby" . "Ruby annotation") ("s" . "Strikeout") ("samp" . "Sample text") + ("script" . "Executable script within a document") ("section" . "Section of a document") ("select" . "Selection list") ("small" . "Font size") + ("source" . "Media resource for media elements") ("sp" . "Nobreak space") ("span" . "Generic inline container") ("strong" . "Standout text") + ("style" . "Style information") ("sub" . "Subscript") + ("summary" . "Summary, caption, or legend") ("sup" . "Superscript") ("table" . "Table with rows and columns") ("tb" . "Table vertical break") + ("tbody" . "Table body") ("td" . "Table data cell") ("textarea" . "Form multiline edit area") + ("tfoot" . "Table foot") ("th" . "Table header cell") + ("thead" . "Table head") + ("time" . "Content with optional machine-readable timestamp") ("title" . "Document title") ("tr" . "Table row separator") + ("track" . "Timed text track for media elements") ("tt" . "Typewriter face") ("u" . "Underlined text") ("ul" . "Unordered list") ("var" . "Math variable face") + ("video" . "Video or movie") ("wbr" . "Enable <br> within <nobr>")) "Value of variable `sgml-tag-help' for HTML mode.") @@ -2031,6 +2203,55 @@ This takes effect when first loading the library.") nil t) (match-string-no-properties 1)))) +(defvar html--buffer-classes-cache nil + "Cache for `html-current-buffer-classes'. +When set, this should be a cons cell where the CAR is the +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-classes-cache) + +(defvar html--buffer-ids-cache nil + "Cache for `html-current-buffer-ids'. +When set, this should be a cons cell where the CAR is the +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) + +(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'." + (let ((tick (buffer-modified-tick))) + (if (eq (car html--buffer-classes-cache) tick) + (cdr html--buffer-classes-cache) + (let* ((dom (libxml-parse-html-region (point-min) (point-max))) + (classes + (seq-mapcat + (lambda (el) + (when-let (class-list + (cdr (assq 'class (dom-attributes el)))) + (split-string class-list))) + (dom-by-class dom "")))) + (setq-local html--buffer-classes-cache (cons tick classes)) + classes)))) + +(defun html-current-buffer-ids () + "Return a list of IDs used in the current buffer. +The result is cached in `html--buffer-ids-cache'." + (let ((tick (buffer-modified-tick))) + (if (eq (car html--buffer-ids-cache) tick) + (cdr html--buffer-ids-cache) + (let* ((dom + (libxml-parse-html-region (point-min) (point-max))) + (ids + (seq-mapcat + (lambda (el) + (when-let (id-list + (cdr (assq 'id (dom-attributes el)))) + (split-string id-list))) + (dom-by-id dom "")))) + (setq-local html--buffer-ids-cache (cons tick ids)) + ids)))) + ;;;###autoload (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") @@ -2081,6 +2302,12 @@ To work around that, do: (setq-local add-log-current-defun-function #'html-current-defun-name) (setq-local sentence-end-base "[.?!][]\"'”)}]*\\(<[^>]*>\\)*") + (when (fboundp 'libxml-parse-html-region) + (defvar css-class-list-function) + (setq-local css-class-list-function #'html-current-buffer-classes) + (defvar css-id-list-function) + (setq-local css-id-list-function #'html-current-buffer-ids)) + (setq imenu-create-index-function 'html-imenu-index) (setq-local sgml-empty-tags |