[elpa] master 55bba22 343/433: Merge pull request #21 from dgutov/syntax-propertize

[Dmitry Gutov]

branch: master
commit 55bba22afddcaf2ac7fc5f1c2aeb7b2d3da90246
Merge: 5c152e0 ea8a1b8
Author: Steve Purcell <address@hidden>
Commit: Steve Purcell <address@hidden>

    Merge pull request #21 from dgutov/syntax-propertize
    
    Define a composite syntax-propertize-function
---
 mmm-class.el  |  1 +
 mmm-erb.el    |  4 +--
 mmm-mode.el   |  4 ++-
 mmm-region.el | 98 ++++++++++++++++++++++++++++++++++++++---------------------
 4 files changed, 70 insertions(+), 37 deletions(-)

diff --git a/mmm-class.el b/mmm-class.el
index b3e48ed..1939edd 100644
--- a/mmm-class.el
+++ b/mmm-class.el
@@ -114,6 +114,7 @@ and interactive history."
   (mmm-clear-overlays start stop 'strict)
   (mmm-apply-classes (mmm-get-all-classes t) :start start :stop stop)
   (mmm-update-submode-region)
+  (syntax-ppss-flush-cache start)
   (mmm-refontify-maybe start stop))
 
 ;;}}}
diff --git a/mmm-erb.el b/mmm-erb.el
index f563a5a..f7dd566 100644
--- a/mmm-erb.el
+++ b/mmm-erb.el
@@ -214,12 +214,12 @@
 
 (defun mmm-erb-scan-region (region)
   (when region ; Can be nil if a line is empty, for example.
-    (destructuring-bind (submode beg end) region
+    (destructuring-bind (submode beg end ovl) region
       (let ((scan-fn (plist-get '(ruby-mode mmm-erb-scan-erb
                                   js-mode   mmm-erb-scan-ejs)
                                 submode)))
         (and scan-fn
-             (overlay-get (mmm-overlay-at beg) 'mmm-special-tag)
+             (overlay-get ovl 'mmm-special-tag)
              (save-excursion
                (goto-char beg)
                (skip-syntax-forward "-")
diff --git a/mmm-mode.el b/mmm-mode.el
index f5c8a86..296e7c2 100644
--- a/mmm-mode.el
+++ b/mmm-mode.el
@@ -6,7 +6,7 @@
 ;; Package: mmm-mode
 ;; Author: Michael Abraham Shulman <address@hidden>
 ;; Keywords: convenience, faces, languages, tools
-;; Version: 0.4.8
+;; Version: 0.5.0
 
 ;; Revision: $Id: mmm-mode.el,v 1.17 2004/06/16 14:14:18 alanshutko Exp $
 
@@ -165,6 +165,8 @@ available through M-x customize under Programming | Tools | 
Mmm."
                                    'syntax-begin-function
                                  'font-lock-beginning-of-syntax-function))
           'mmm-beginning-of-syntax)
+     (set (make-local-variable 'syntax-propertize-function)
+          'mmm-syntax-propertize-function)
      (setq mmm-mode t)
      (condition-case err
          (mmm-apply-all)
diff --git a/mmm-region.el b/mmm-region.el
index 8d7c2ba..ee97390 100644
--- a/mmm-region.el
+++ b/mmm-region.el
@@ -200,15 +200,6 @@ and update the saved previous values."
   (setq mmm-current-submode mode
         mmm-current-overlay ovl))
 
-;; TODO: Only used in `mmm-fontify-region-list', so far.
-;; Might be worth eliminating by making `mmm-regions-alist' include overlay
-;; references, not just the bounds of regions.
-(defun mmm-submode-overlay-at (mode &optional pos)
-  "Return the highest priority region of MODE at POS or point, if any."
-  (find-if #'(lambda (ovl)
-               (eq (overlay-get ovl 'mmm-mode) mode))
-           (mmm-overlays-at pos 'all)))
-
 (defun mmm-submode-at (&optional pos type)
   "Return the submode at POS \(or point), or NIL if none.
 See `mmm-included-p' for values of TYPE."
@@ -516,7 +507,9 @@ is non-nil, don't quit if the info is already there."
                 (put mode 'mmm-fontify-region-function
                      font-lock-fontify-region-function)
                 (put mode 'mmm-beginning-of-syntax-function
-                     font-lock-beginning-of-syntax-function))
+                     font-lock-beginning-of-syntax-function)
+                (put mode 'mmm-syntax-propertize-function
+                     syntax-propertize-function))
               ;; Get variables
               (setq global-vars (mmm-get-locals 'global)
                     buffer-vars (mmm-get-locals 'buffer)
@@ -609,14 +602,15 @@ Return \((VAR VALUE) ...).  In some cases, VAR will be of 
the form
 
 (defun mmm-set-local-variables (mode ovl)
   "Set all the local variables saved for MODE and OVL.
-Looks up both global, buffer, and region saves."
+Looks up global, buffer and region saves.  When MODE is nil, just
+the region ones."
   (mapcar #'(lambda (var)
               ;; (car VAR) may be (GETTER . SETTER)
               (if (consp (car var))
                   (funcall (cdar var) (cadr var))
                 (make-local-variable (car var))
                 (set (car var) (cadr var))))
-          (mmm-get-saved-local-variables (or mode mmm-primary-mode) ovl)))
+          (mmm-get-saved-local-variables mode ovl)))
 
 (defun mmm-get-saved-local-variables (mode ovl)
   (append (get mode 'mmm-local-variables)
@@ -701,32 +695,38 @@ The list is sorted in order of increasing buffer 
position."
         #'<))
 
 (defun mmm-regions-in (start stop)
-  "Return a list of regions of the form (MODE BEG END) whose disjoint
+  "Return a list of regions of the form (MODE BEG END OVL) whose disjoint
 union covers the region from START to STOP, including delimiters."
   (let ((regions 
          (maplist #'(lambda (pos-list)
-                      (if (cdr pos-list)
-                          (list (or (mmm-submode-at (car pos-list) 'beg)
-                                    mmm-primary-mode)
-                                (car pos-list) (cadr pos-list))))
+                      (when (cdr pos-list)
+                        (let ((ovl (mmm-overlay-at (car pos-list) 'beg)))
+                          (list (if ovl
+                                    (overlay-get ovl 'mmm-mode)
+                                  mmm-primary-mode)
+                                (car pos-list) (cadr pos-list)
+                                ovl))))
                   (mmm-submode-changes-in start stop))))
     (setcdr (last regions 2) nil)
     regions))
 
-
 (defun mmm-regions-alist (start stop)
   "Return a list of lists of the form \(MODE . REGIONS) where REGIONS
-is a list of elements of the form \(BEG END). The disjoint union all
+is a list of elements of the form \(BEG END OVL). The disjoint union all
 of the REGIONS covers START to STOP."
-  (let ((regions (mmm-regions-in start stop)))
-    (mapcar #'(lambda (mode)
-                (cons mode
-                      (mapcan #'(lambda (region)
-                                  (if (eq mode (car region))
-                                      (list (cdr region))))
-                              regions)))
-            ;; All the modes
-            (remove-duplicates (mapcar #'car regions)))))
+  (let ((regions (mmm-regions-in start stop))
+        alist)
+    (mapc (lambda (region)
+            (let* ((mode (car region))
+                   (elem (cdr region))
+                   (kv (assoc mode alist)))
+              (if kv
+                  (push elem (cdr kv))
+                (push (cons mode (list elem)) alist))))
+          regions)
+    (mapcar (lambda (kv)
+              (cons (car kv) (nreverse (cdr kv))))
+            alist)))
 
 ;;}}}
 ;;{{{ Fontify Regions
@@ -753,14 +753,13 @@ of the REGIONS covers START to STOP."
       ;; `post-command-hook' contains `mmm-update-submode-region',
       ;; but jit-lock runs later, so we need to restore local vars now.
       (mmm-set-current-pair saved-mode saved-ovl)
-      (mmm-set-local-variables saved-mode saved-ovl)))
+      (mmm-set-local-variables (or saved-mode mmm-primary-mode) saved-ovl)))
   (when loudly (message nil)))
 
 (defun mmm-fontify-region-list (mode regions)
   "Fontify REGIONS, each like \(BEG END), in mode MODE."
   (save-excursion
-    (let (;(major-mode mode)
-          (func (get mode 'mmm-fontify-region-function))
+    (let ((func (get mode 'mmm-fontify-region-function))
           font-lock-extend-region-functions)
       (mapc #'(lambda (reg)
                   (goto-char (car reg))
@@ -768,8 +767,10 @@ of the REGIONS covers START to STOP."
                   ;; `mmm-update-submode-region' does, but we force it
                   ;; to use a specific mode, and don't save anything,
                   ;; fontify, or change the mode line.
-                  (mmm-set-current-pair mode (mmm-submode-overlay-at mode))
-                  (mmm-set-local-variables mode mmm-current-overlay)
+                  (mmm-set-current-pair mode (caddr reg))
+                  (mmm-set-local-variables (unless (eq mmm-previous-submode 
mode)
+                                             mode)
+                                           mmm-current-overlay)
                   (funcall func (car reg) (cadr reg) nil)
                   ;; Catch changes in font-lock cache.
                   (mmm-save-changed-local-variables
@@ -777,7 +778,7 @@ of the REGIONS covers START to STOP."
               regions))))
 
 ;;}}}
-;;{{{ Beginning of Syntax
+;;{{{ Syntax
 
 (defun mmm-beginning-of-syntax ()
   (goto-char
@@ -788,6 +789,35 @@ of the REGIONS covers START to STOP."
           (if func (progn (funcall func) (point)) (point-min))
           (point-min)))))
 
+(defun mmm-syntax-propertize-function (start stop)
+  (let ((saved-mode mmm-current-submode)
+        (saved-ovl  mmm-current-overlay))
+    (mmm-save-changed-local-variables
+     mmm-current-submode mmm-current-overlay)
+    (unwind-protect
+        (mapc #'(lambda (elt)
+                  (let* ((mode (car elt))
+                         (func (get mode 'mmm-syntax-propertize-function))
+                         (beg (cadr elt)) (end (caddr elt))
+                         (ovl (cadddr elt)))
+                    (goto-char beg)
+                    (mmm-set-current-pair mode ovl)
+                    (mmm-set-local-variables mode mmm-current-overlay)
+                    (save-restriction
+                      (if mmm-current-overlay
+                          (narrow-to-region (overlay-start mmm-current-overlay)
+                                            (overlay-end mmm-current-overlay))
+                        (narrow-to-region beg end))
+                      (cond
+                       (func
+                        (funcall func beg end))
+                       (font-lock-syntactic-keywords
+                        (let ((syntax-propertize-function nil))
+                          (font-lock-fontify-syntactic-keywords-region beg 
end)))))))
+              (mmm-regions-in start stop))
+      (mmm-set-current-pair saved-mode saved-ovl)
+      (mmm-set-local-variables saved-mode saved-ovl))))
+
 ;;}}}
 
 (provide 'mmm-region)