[elpa] master c28501c 387/433: Don't use syntax-begin-function

[Dmitry Gutov]

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

    Don't use syntax-begin-function
    
    http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00226.html
    #37
---
 mmm-class.el    |  1 +
 mmm-mode.el     |  9 ++------
 mmm-region.el   | 67 +++++++++++++++++++++++----------------------------------
 tests/region.el | 12 -----------
 4 files changed, 30 insertions(+), 59 deletions(-)

diff --git a/mmm-class.el b/mmm-class.el
index 3f40e1f..436e85a 100644
--- a/mmm-class.el
+++ b/mmm-class.el
@@ -114,6 +114,7 @@ and interactive history."
   (mmm-apply-classes (mmm-get-all-classes t) :start start :stop stop)
   (mmm-update-submode-region)
   (syntax-ppss-flush-cache start)
+  (syntax-propertize stop)
   (mmm-refontify-maybe start stop))
 
 ;;}}}
diff --git a/mmm-mode.el b/mmm-mode.el
index b9ce714..4bbf927 100644
--- a/mmm-mode.el
+++ b/mmm-mode.el
@@ -163,10 +163,7 @@ available through M-x customize-group RET mmm."
      (mmm-fixup-skeleton)
      (make-local-variable 'font-lock-fontify-region-function)
      (setq font-lock-fontify-region-function 'mmm-fontify-region)
-     (set (make-local-variable (if (boundp 'syntax-begin-function) ; Emacs >= 
23
-                                   'syntax-begin-function
-                                 'font-lock-beginning-of-syntax-function))
-          'mmm-beginning-of-syntax)
+     (set (make-local-variable 'syntax-begin-function) nil)
      (set (make-local-variable 'syntax-propertize-function)
           'mmm-syntax-propertize-function)
      (set (make-local-variable 'indent-line-function) mmm-indent-line-function)
@@ -197,9 +194,7 @@ available through M-x customize-group RET mmm."
     (mmm-update-submode-region)
     (setq font-lock-fontify-region-function
           (get mmm-primary-mode 'mmm-fontify-region-function))
-    (set (if (boundp 'syntax-begin-function) ; Emacs >= 23
-             'syntax-begin-function
-           'font-lock-beginning-of-syntax-function)
+    (set 'syntax-begin-function
          (get mmm-primary-mode 'mmm-beginning-of-syntax-function))
     (mmm-update-font-lock-buffer)
     (mmm-refontify-maybe)
diff --git a/mmm-region.el b/mmm-region.el
index d95df0e..5d9b987 100644
--- a/mmm-region.el
+++ b/mmm-region.el
@@ -510,8 +510,7 @@ 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
-                     (or syntax-begin-function
-                         font-lock-beginning-of-syntax-function))
+                     syntax-begin-function)
                 (put mode 'mmm-syntax-propertize-function
                      (and (boundp 'syntax-propertize-function)
                           syntax-propertize-function))
@@ -726,18 +725,19 @@ 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 OVL) whose disjoint
 union covers the region from START to STOP, including delimiters."
-  (let ((regions 
-         (maplist #'(lambda (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))
+  (when (> stop start)
+    (let ((regions
+           (maplist #'(lambda (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
@@ -771,14 +771,10 @@ of the REGIONS covers START to STOP."
           ;; Necessary to catch changes in font-lock cache state and position.
           (mmm-save-changed-local-variables
            mmm-current-submode mmm-current-overlay)
-          ;; For some reason `font-lock-fontify-block' binds this to nil, thus
-          ;; preventing `mmm-beginning-of-syntax' from doing The Right Thing.
-          ;; I don't know why it does this, but let's undo it here.
-          (let ((font-lock-beginning-of-syntax-function 
'mmm-beginning-of-syntax))
-            (mapc #'(lambda (elt)
-                      (when (get (car elt) 'mmm-font-lock-mode)
-                        (mmm-fontify-region-list (car elt) (cdr elt))))
-                  (mmm-regions-alist start stop))))
+          (mapc #'(lambda (elt)
+                    (when (get (car elt) 'mmm-font-lock-mode)
+                      (mmm-fontify-region-list (car elt) (cdr elt))))
+                (mmm-regions-alist start 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)
@@ -791,35 +787,29 @@ of the REGIONS covers START to STOP."
     (let ((func (get mode 'mmm-fontify-region-function))
           font-lock-extend-region-functions)
       (mapc #'(lambda (reg)
-                  (goto-char (car reg))
+                (destructuring-bind (beg end ovl) reg
+                  (goto-char beg)
                   ;; Here we do the same sort of thing that
                   ;; `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 (caddr reg))
+                  (mmm-set-current-pair mode ovl)
                   (mmm-set-local-variables (unless (eq mmm-previous-submode 
mode)
                                              mode)
                                            mmm-current-overlay)
-                  (let ((syntax-ppss-last (and (caddr reg) (list (car reg))))
-                        syntax-ppss-cache)
-                    (funcall func (car reg) (cadr reg) nil))
+                  (save-restriction
+                    (let ((font-lock-dont-widen t)
+                          syntax-ppss-last syntax-ppss-cache)
+                      (when ovl (narrow-to-region beg end))
+                      (funcall func beg end nil)))
                   ;; Catch changes in font-lock cache.
                   (mmm-save-changed-local-variables
-                   mmm-current-submode mmm-current-overlay))
+                   mmm-current-submode mmm-current-overlay)))
               regions))))
 
 ;;}}}
 ;;{{{ Syntax
 
-(defun mmm-beginning-of-syntax ()
-  (goto-char
-   (let ((ovl (mmm-overlay-at (point) 'beg))
-         (func (get (or mmm-current-submode mmm-primary-mode)
-                    'mmm-beginning-of-syntax-function)))
-     (max (if ovl (overlay-start ovl) (point-min))
-          (if func (progn (funcall func) (point)) (point-min))
-          (point-min)))))
-
 (defvar mmm-after-syntax-propertize-functions nil
   "List of functions to call after applying `syntax-table' text
 properties to a submode region. It is passed four arguments: the
@@ -846,9 +836,6 @@ calls each respective submode's 
`syntax-propertize-function'."
                     (mmm-set-local-variables mode mmm-current-overlay)
                     (save-restriction
                       (when mmm-current-overlay
-                        ;; Simple optimization to avoid calling 
syntax-beginning
-                        ;; for small buffers.
-                        (setq syntax-ppss-last (list beg))
                         (narrow-to-region (overlay-start mmm-current-overlay)
                                           (overlay-end mmm-current-overlay)))
                       (cond
diff --git a/tests/region.el b/tests/region.el
deleted file mode 100644
index 50e2810..0000000
--- a/tests/region.el
+++ /dev/null
@@ -1,12 +0,0 @@
-(ert-deftest mmm-beginning-of-syntax-goes-to-outer-beginning ()
-  (ert-with-test-buffer nil
-    (let (mmm-mode-ext-classes-alist
-          mmm-parse-when-idle)
-      (insert "aaa [zz {x} zz] bbb")
-      (fundamental-mode)
-      (mmm-mode-on)
-      (mmm-ify-by-regexp 'text-mode "\\[" 0 "\\]" 0 nil)
-      (mmm-ify-by-regexp 'prog-mode "{" 0 "}" 0 nil)
-      (search-backward "}")
-      (mmm-beginning-of-syntax)
-      (should (looking-back "\\[" (1- (point)))))))