Re: html, css, and js modes working together

[Tom Tromey]

>>>>> "Dmitry" == Dmitry Gutov <address@hidden> writes:

>> I've appended the current code.

Dmitry> I'm getting "Symbol’s value as variable is void:
Dmitry> sgml-syntax-propertize-rules". Does it still require parts of the
Dmitry> previous patch?

Yeah, sorry, I only appended the new mode's file since I thought you
only wanted it to see what it was doing.

Here's my current patch, now with pre- and post-command hooks and
flyspell integration.  Font lock mostly works but has some oddities, and
I still didn't fix the html comment/syntax bug that Clément found.

This is way smaller than I thought it would end up being, basically I
think because syntax-propertizing is a nice tool.

Tom

diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 4d02b75..7baccbc 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -123,6 +123,8 @@
 
 (eval-when-compile (require 'cl-lib))
 
+(require 'prog-mode)
+
 (defgroup smie nil
   "Simple Minded Indentation Engine."
   :group 'languages)
@@ -1455,7 +1457,7 @@ smie-indent-bob
   ;; Start the file at column 0.
   (save-excursion
     (forward-comment (- (point)))
-    (if (bobp) 0)))
+    (if (bobp) (prog-first-column))))
 
 (defun smie-indent-close ()
   ;; Align close paren with opening paren.
diff --git a/lisp/files.el b/lisp/files.el
index b7d1048..77c1e41 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2422,7 +2422,7 @@ auto-mode-alist
    (lambda (elt)
      (cons (purecopy (car elt)) (cdr elt)))
    `(;; do this first, so that .html.pl is Polish html, not Perl
-     ("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
+     ("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . mhtml-mode)
      ("\\.svgz?\\'" . image-mode)
      ("\\.svgz?\\'" . xml-mode)
      ("\\.x[bp]m\\'" . image-mode)
@@ -2784,8 +2784,8 @@ magic-fallback-mode-alist
                comment-re "*"
                "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re 
"*\\)?"
                "[Hh][Tt][Mm][Ll]"))
-     . html-mode)
-    ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . html-mode)
+     . mhtml-mode)
+    ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
     ;; These two must come after html, because they are more general:
     ("<\\?xml " . xml-mode)
     (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index b42b2bc..05bf635 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -53,6 +53,7 @@
 (require 'moz nil t)
 (require 'json nil t)
 (require 'sgml-mode)
+(require 'prog-mode)
 
 (eval-when-compile
   (require 'cl-lib)
@@ -2109,7 +2110,7 @@ js--proper-indentation
 
           ((js--continued-expression-p)
            (+ js-indent-level js-expr-indent-offset))
-          (t 0))))
+          (t (prog-first-column)))))
 
 ;;; JSX Indentation
 
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
new file mode 100644
index 0000000..a647060
--- /dev/null
+++ b/lisp/textmodes/mhtml-mode.el
@@ -0,0 +1,274 @@
+;;; mhtml-mode.el --- HTML editing mode that handles CSS and JS -*- 
lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Keywords: wp, hypermedia, comm, languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(eval-and-compile
+  (require 'sgml-mode))
+(require 'js)
+(require 'css-mode)
+(require 'prog-mode)
+(require 'font-lock)
+
+(cl-defstruct mhtml--submode
+  ;; Name of this submode.
+  name
+  ;; HTML end tag.
+  end-tag
+  ;; Syntax table.
+  syntax-table
+  ;; Propertize function.
+  propertize
+  ;; Keymap.
+  keymap
+  ;; Captured locals that are set when entering a region.
+  crucial-captured-locals
+  ;; Other captured local variables; these are not set when entering a
+  ;; region but let-bound during certain operations, e.g.,
+  ;; indentation.
+  captured-locals)
+
+(defconst mhtml--crucial-variable-prefix
+  (regexp-opt '("comment-" "uncomment-" "electric-indent-"
+                "smie-" "forward-sexp-function"))
+  "Regexp matching the prefix of \"crucial\" buffer-locals we want to 
capture.")
+
+(defconst mhtml--variable-prefix
+  (regexp-opt '("font-lock-" "indent-line-function" "major-mode"))
+  "Regexp matching the prefix of buffer-locals we want to capture.")
+
+(defun mhtml--construct-submode (mode &rest args)
+  "A wrapper for make-mhtml--submode that computes the buffer-local variables."
+  (let ((captured-locals nil)
+        (crucial-captured-locals nil)
+        (submode (apply #'make-mhtml--submode args)))
+    (with-temp-buffer
+      (funcall mode)
+      ;; Make sure font lock is all set up.
+      (font-lock-set-defaults)
+      (dolist (iter (buffer-local-variables))
+        (when (string-match mhtml--crucial-variable-prefix
+                            (symbol-name (car iter)))
+          (push iter crucial-captured-locals))
+        (when (string-match mhtml--variable-prefix (symbol-name (car iter)))
+          (push iter captured-locals)))
+      (setf (mhtml--submode-crucial-captured-locals submode)
+            crucial-captured-locals)
+      (setf (mhtml--submode-captured-locals submode) captured-locals))
+    submode))
+
+(defun mhtml--mark-buffer-locals (submode)
+  (dolist (iter (mhtml--submode-captured-locals submode))
+    (make-local-variable (car iter))))
+
+(defvar-local mhtml--crucial-variables nil
+  "List of all crucial variable symbols.")
+
+(defun mhtml--mark-crucial-buffer-locals (submode)
+  (dolist (iter (mhtml--submode-crucial-captured-locals submode))
+    (make-local-variable (car iter))
+    (push (car iter) mhtml--crucial-variables)))
+
+(defconst mhtml--css-submode
+  (mhtml--construct-submode 'css-mode
+                            :name "CSS"
+                            :end-tag "</style>"
+                            :syntax-table css-mode-syntax-table
+                            :propertize css-syntax-propertize-function
+                            :keymap css-mode-map))
+
+(defconst mhtml--js-submode
+  (mhtml--construct-submode 'js-mode
+                            :name "JS"
+                            :end-tag "</script>"
+                            :syntax-table js-mode-syntax-table
+                            :propertize #'js-syntax-propertize
+                            :keymap js-mode-map))
+
+(defmacro mhtml--with-locals (submode &rest body)
+  (declare (indent 1))
+  `(cl-progv
+       (when submode (mapcar #'car (mhtml--submode-captured-locals submode)))
+       (when submode (mapcar #'cdr (mhtml--submode-captured-locals submode)))
+     (cl-progv
+         (when submode (mapcar #'car (mhtml--submode-crucial-captured-locals
+                                      submode)))
+         (when submode (mapcar #'cdr (mhtml--submode-crucial-captured-locals
+                                      submode)))
+       ,@body)))
+
+(defun mhtml--submode-lighter ()
+  "Mode-line lighter indicating the current submode."
+  (let ((submode (get-text-property (point) 'mhtml-submode)))
+    (if submode
+        (mhtml--submode-name submode)
+      "")))
+
+(defun mhtml--submode-fontify-one-region (submode beg end &optional loudly)
+  (if submode
+      (mhtml--with-locals submode
+        (save-restriction
+          (narrow-to-region beg end)
+          (font-lock-set-defaults)
+          (font-lock-default-fontify-region (point-min) (point-max) loudly)))
+    (font-lock-set-defaults)
+    (font-lock-default-fontify-region beg end loudly)))
+
+(defun mhtml--submode-fontify-region (beg end loudly)
+  (while (< beg end)
+    (let ((submode (get-text-property beg 'mhtml-submode))
+          (this-end (next-single-property-change beg 'mhtml-submode
+                                                 nil end)))
+      (mhtml--submode-fontify-one-region submode beg this-end loudly)
+      (setq beg this-end))))
+
+(defvar-local mhtml--last-submode nil
+  "Record the last visited submode, so the cursor-sensor function
+can function properly.")
+
+(defvar-local mhtml--stashed-crucial-variables nil
+  "Alist of stashed values of the crucial variables.")
+
+(defun mhtml--stash-crucial-variables ()
+  (setq mhtml--stashed-crucial-variables
+        (mapcar (lambda (sym)
+                  (cons sym (buffer-local-value sym (current-buffer))))
+                mhtml--crucial-variables)))
+
+(defun mhtml--map-in-crucial-variables (alist)
+  (dolist (item alist)
+    (set (car item) (cdr item))))
+
+(defun mhtml--pre-command ()
+  (let ((submode (get-text-property (point) 'mhtml-submode)))
+    (unless (eq submode mhtml--last-submode)
+      ;; If we're entering a submode, and the previous submode was
+      ;; nil, then stash the current values first.  This lets the user
+      ;; at least modify some values directly.  FIXME maybe always
+      ;; stash into the current mode?
+      (when (and submode (not mhtml--last-submode))
+        (mhtml--stash-crucial-variables))
+      (mhtml--map-in-crucial-variables
+       (if submode
+           (mhtml--submode-crucial-captured-locals submode)
+         mhtml--stashed-crucial-variables))
+      (setq mhtml--last-submode submode))))
+
+(defun mhtml--syntax-propertize-submode (submode end)
+  (save-excursion
+    (when (search-forward (mhtml--submode-end-tag submode) end t)
+      (setq end (match-beginning 0))))
+  (set-text-properties (point) end
+                       (list 'mhtml-submode submode
+                             'syntax-table (mhtml--submode-syntax-table 
submode)
+                             ;; We want local-map here so that we act
+                             ;; more like the sub-mode and don't
+                             ;; override minor mode maps.
+                             'local-map (mhtml--submode-keymap submode)))
+  (funcall (mhtml--submode-propertize submode) (point) end)
+  (goto-char end))
+
+(defun mhtml-syntax-propertize (start end)
+  (goto-char start)
+  (when (get-text-property (point) 'mhtml-submode)
+    (mhtml--syntax-propertize-submode (get-text-property (point) 
'mhtml-submode)
+                                      end))
+  (funcall
+   (syntax-propertize-rules
+    ("<style.*?>"
+     (0 (ignore
+         (goto-char (match-end 0))
+         (mhtml--syntax-propertize-submode mhtml--css-submode end))))
+    ("<script.*?>"
+     (0 (ignore
+         (goto-char (match-end 0))
+         (mhtml--syntax-propertize-submode mhtml--js-submode end))))
+    sgml-syntax-propertize-rules)
+   ;; Make sure to handle the situation where
+   ;; mhtml--syntax-propertize-submode moved point.
+   (point) end))
+
+(defun mhtml-indent-line ()
+  "Indent the current line as HTML, JS, or CSS, according to its context."
+  (interactive)
+  (let ((submode (save-excursion
+                   (back-to-indentation)
+                   (get-text-property (point) 'mhtml-submode))))
+    (if submode
+        (save-restriction
+          (let* ((region-start (previous-single-property-change (point)
+                                                                
'mhtml-submode))
+                 (base-indent (save-excursion
+                                (goto-char region-start)
+                                (sgml-calculate-indent))))
+            (narrow-to-region region-start (point-max))
+            (let ((prog-indentation-context (list base-indent
+                                                  (cons (point-min) nil)
+                                                  nil)))
+              (mhtml--with-locals submode
+                ;; indent-line-function was rebound by
+                ;; mhtml--with-locals.
+                (funcall indent-line-function)))))
+      ;; HTML.
+      (sgml-indent-line))))
+
+(defun mhtml--flyspell-check-word ()
+  (let ((submode (get-text-property (point) 'mhtml-submode)))
+    (if submode
+        (flyspell-generic-progmode-verify)
+      t)))
+
+;;;###autoload
+(define-derived-mode mhtml-mode html-mode
+  '((sgml-xml-mode "XHTML+" "HTML+") (:eval (mhtml--submode-lighter)))
+  "Major mode based on `html-mode', but works with embedded JS and CSS.
+
+Code inside a <script> element is indented using the rules from
+`js-mode'; and code inside a <style> element is indented using
+the rules from `css-mode'."
+  (cursor-sensor-mode)
+  (setq-local indent-line-function #'mhtml-indent-line)
+  (setq-local parse-sexp-lookup-properties t)
+  (setq-local syntax-propertize-function #'mhtml-syntax-propertize)
+  (setq-local font-lock-fontify-region-function
+              #'mhtml--submode-fontify-region)
+
+  ;; Attach this to both pre- and post- hooks just in case it ever
+  ;; changes a key binding that might be accessed from the menu bar.
+  (add-hook 'pre-command-hook #'mhtml--pre-command nil t)
+  (add-hook 'post-command-hook #'mhtml--pre-command nil t)
+
+  ;; Make any captured variables buffer-local.
+  (mhtml--mark-buffer-locals mhtml--css-submode)
+  (mhtml--mark-buffer-locals mhtml--js-submode)
+
+  (mhtml--mark-crucial-buffer-locals mhtml--css-submode)
+  (mhtml--mark-crucial-buffer-locals mhtml--js-submode)
+  (setq mhtml--crucial-variables (delete-dups mhtml--crucial-variables))
+
+  ;: Hack
+  (js--update-quick-match-re))
+
+(put 'mhtml-mode 'flyspell-mode-predicate #'mhtml--flyspell-check-word)
+
+(provide 'mhtml-mode)
+
+;;; mhtml-mode.el ends here
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index e148b06..8ad7cfb 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -341,19 +341,23 @@ sgml-font-lock-keywords-2
 (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
   "Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
 
+(eval-and-compile
+  (defconst sgml-syntax-propertize-rules
+    (syntax-propertize-precompile-rules
+     ;; Use the `b' style of comments to avoid interference with the -- ... --
+     ;; comments recognized when `sgml-specials' includes ?-.
+     ;; 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 ".")))))))
+
 (defconst sgml-syntax-propertize-function
-  (syntax-propertize-rules
-   ;; Use the `b' style of comments to avoid interference with the -- ... --
-   ;; comments recognized when `sgml-specials' includes ?-.
-  ;; 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 ".")))))
+  (syntax-propertize-rules sgml-syntax-propertize-rules)
   "Syntactic keywords for `sgml-mode'.")
 
 ;; internal
@@ -1284,13 +1288,24 @@ sgml-tag-text-p
       (let ((pps (parse-partial-sexp start end 2)))
        (and (= (nth 0 pps) 0))))))
 
+(defun sgml--find-<>-backward (limit)
+  "Search backward for a '<' or '>' character.
+The character must have open or close syntax.
+Returns t if found, nil otherwise."
+  (catch 'found
+    (while (re-search-backward "[<>]" limit 'move)
+      ;; If this character has "open" or "close" syntax, then we've
+      ;; found the one we want.
+      (when (memq (syntax-class (syntax-after (point))) '(4 5))
+        (throw 'found t)))))
+
 (defun sgml-parse-tag-backward (&optional limit)
   "Parse an SGML tag backward, and return information about the tag.
 Assume that parsing starts from within a textual context.
 Leave point at the beginning of the tag."
   (catch 'found
     (let (tag-type tag-start tag-end name)
-      (or (re-search-backward "[<>]" limit 'move)
+      (or (sgml--find-<>-backward limit)
          (error "No tag found"))
       (when (eq (char-after) ?<)
        ;; Oops!! Looks like we were not in a textual context after all!.