[elpa] master 3ac63b8 336/433: Define mmm-syntax-propertize-function

[Dmitry Gutov]

branch: master
commit 3ac63b8d413854b55befb68e81cdfe342b1b62bc
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Define mmm-syntax-propertize-function
    
    This is faster, but still kinda slow.
---
 mmm-mode.el   |  2 ++
 mmm-region.el | 46 ++++++++++++++++++++++++++++++----------------
 2 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/mmm-mode.el b/mmm-mode.el
index f5c8a86..26984d0 100644
--- a/mmm-mode.el
+++ b/mmm-mode.el
@@ -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 dfe720f..33e7fec 100644
--- a/mmm-region.el
+++ b/mmm-region.el
@@ -761,12 +761,8 @@ of the REGIONS covers START to STOP."
 (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))
-          (font-lock-dont-widen t)
-          font-lock-extend-region-functions
-          syntax-propertize-extend-region-functions
-          (syntax-propertize-function (get mode 
'mmm-syntax-propertize-function)))
+    (let ((func (get mode 'mmm-fontify-region-function))
+          font-lock-extend-region-functions)
       (mapc #'(lambda (reg)
                   (goto-char (car reg))
                   ;; Here we do the same sort of thing that
@@ -775,22 +771,14 @@ of the REGIONS covers START to STOP."
                   ;; fontify, or change the mode line.
                   (mmm-set-current-pair mode (mmm-submode-overlay-at mode))
                   (mmm-set-local-variables mode mmm-current-overlay)
-                  ;; (message "beg %s end %s spd %s" (car reg) (cadr reg)
-                  ;;          syntax-propertize--done)
-                  (save-restriction
-                    (if mmm-current-overlay
-                        (narrow-to-region (overlay-start mmm-current-overlay)
-                                          (overlay-end mmm-current-overlay))
-                      (narrow-to-region (car reg) (cadr reg)))
-                    (let ((syntax-propertize--done (car reg))) ;; tis slow :(
-                      (funcall func (car reg) (cadr reg) nil)))
+                  (funcall func (car reg) (cadr reg) nil)
                   ;; Catch changes in font-lock cache.
                   (mmm-save-changed-local-variables
                    mmm-current-submode mmm-current-overlay))
               regions))))
 
 ;;}}}
-;;{{{ Beginning of Syntax
+;;{{{ Syntax
 
 (defun mmm-beginning-of-syntax ()
   (goto-char
@@ -801,6 +789,32 @@ 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)
+                  (destructuring-bind (mode beg end) elt
+                    (goto-char beg)
+                    (mmm-set-current-pair mode (mmm-submode-overlay-at mode))
+                    (mmm-set-local-variables mode mmm-current-overlay)
+                    (let ((syntax-propertize-chunk-size (- end beg))
+                          (func (get mode 'mmm-syntax-propertize-function)))
+                      (if func
+                          (save-restriction
+                            (if mmm-current-overlay
+                                (narrow-to-region (overlay-start 
mmm-current-overlay)
+                                                  (overlay-end 
mmm-current-overlay))
+                              (narrow-to-region beg end))
+                            (funcall func beg end))
+                        (remove-text-properties
+                         beg end '(syntax-table nil syntax-multiline nil))))))
+              (mmm-regions-in start stop))
+      (mmm-set-current-pair saved-mode saved-ovl)
+      (mmm-set-local-variables saved-mode saved-ovl))))
+
 ;;}}}
 
 (provide 'mmm-region)