]> git.eshelyaron.com Git - emacs.git/commitdiff
Move easy-mmode-define-navigation logic to helper functions
authorSpencer Baugh <sbaugh@janestreet.com>
Tue, 10 Sep 2024 17:46:18 +0000 (13:46 -0400)
committerEshel Yaron <me@eshelyaron.com>
Fri, 27 Sep 2024 10:23:55 +0000 (12:23 +0200)
The functions defined by easy-mmode-define-navigation are useful
even if the easy-mmode-define-navigation macro is not used.
Let's take a step towards exposing them by moving them out as
helpers.

This also makes the macro much easier to modify and work on.

* lisp/emacs-lisp/easy-mmode.el (easy-mmode--prev)
(easy-mmode--next): Add (bug#73172).
(easy-mmode-define-navigation): Use easy-mmode--prev and
easy-mmode--next.

(cherry picked from commit da1416fc6998718d1e36e32961b4415045949632)

lisp/emacs-lisp/easy-mmode.el

index f5a9f443f2af61edafb7ad877373270daeb36f7d..54c20d20e0d0a2f162eb4eb8c2ae5ed846d20f3a 100644 (file)
@@ -761,6 +761,48 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
 ;;; easy-mmode-define-navigation
 ;;;
 
+(defun easy-mmode--prev (re name count &optional endfun narrowfun)
+  "Go to the previous COUNT'th occurence of RE.
+
+If none, error with NAME.
+
+ENDFUN and NARROWFUN are treated like in `easy-mmode-define-navigation'."
+  (unless count (setq count 1))
+  (if (< count 0) (easy-mmode--next re name (- count) endfun narrowfun)
+    (let ((re-narrow (and narrowfun (prog1 (buffer-narrowed-p) (widen)))))
+      (unless (re-search-backward re nil t count)
+        (user-error "No previous %s" name))
+      (when re-narrow (funcall narrowfun)))))
+
+(defun easy-mmode--next (re name count &optional endfun narrowfun)
+  "Go to the next COUNT'th occurence of RE.
+
+If none, error with NAME.
+
+ENDFUN and NARROWFUN are treated like in `easy-mmode-define-navigation'."
+  (unless count (setq count 1))
+  (if (< count 0) (easy-mmode--prev re name (- count) endfun narrowfun)
+    (if (looking-at re) (setq count (1+ count)))
+    (let ((re-narrow (and narrowfun (prog1 (buffer-narrowed-p) (widen)))))
+      (if (not (re-search-forward re nil t count))
+          (if (looking-at re)
+              (goto-char (or (if endfun (funcall endfun)) (point-max)))
+            (user-error "No next %s" name))
+        (goto-char (match-beginning 0))
+        (when (and (eq (current-buffer) (window-buffer))
+                   (called-interactively-p 'interactive))
+          (let ((endpt (or (save-excursion
+                             (if endfun (funcall endfun)
+                               (re-search-forward re nil t 2)))
+                           (point-max))))
+            (unless (pos-visible-in-window-p endpt nil t)
+              (let ((ws (window-start)))
+                (recenter '(0))
+                (if (< (window-start) ws)
+                    ;; recenter scrolled in the wrong direction!
+                    (set-window-start nil ws)))))))
+      (when re-narrow (funcall narrowfun)))))
+
 (defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun
                                              &rest body)
   "Define BASE-next and BASE-prev to navigate in the buffer.
@@ -778,53 +820,23 @@ BODY is executed after moving to the destination location."
   (let* ((base-name (symbol-name base))
         (prev-sym (intern (concat base-name "-prev")))
         (next-sym (intern (concat base-name "-next")))
-         (when-narrowed
-          (lambda (body)
-            (if (null narrowfun) body
-              `(let ((was-narrowed (prog1 (buffer-narrowed-p) (widen))))
-                 ,body
-                 (when was-narrowed (funcall #',narrowfun)))))))
+         (endfun (when endfun `#',endfun))
+         (narrowfun (when narrowfun `#',narrowfun)))
     (unless name (setq name base-name))
-    ;; FIXME: Move most of those functions's bodies to helper functions!
     `(progn
        (defun ,next-sym (&optional count)
         ,(format "Go to the next COUNT'th %s.
 Interactively, COUNT is the prefix numeric argument, and defaults to 1." name)
         (interactive "p")
-        (unless count (setq count 1))
-        (if (< count 0) (,prev-sym (- count))
-          (if (looking-at ,re) (setq count (1+ count)))
-           ,(funcall when-narrowed
-             `(if (not (re-search-forward ,re nil t count))
-                  (if (looking-at ,re)
-                      (goto-char (or ,(if endfun `(funcall #',endfun)) (point-max)))
-                    (user-error "No next %s" ,name))
-                (goto-char (match-beginning 0))
-                (when (and (eq (current-buffer) (window-buffer))
-                           (called-interactively-p 'interactive))
-                  (let ((endpt (or (save-excursion
-                                     ,(if endfun `(funcall #',endfun)
-                                        `(re-search-forward ,re nil t 2)))
-                                   (point-max))))
-                    (unless (pos-visible-in-window-p endpt nil t)
-                      (let ((ws (window-start)))
-                        (recenter '(0))
-                        (if (< (window-start) ws)
-                            ;; recenter scrolled in the wrong direction!
-                            (set-window-start nil ws))))))))
-           ,@body))
+         (easy-mmode--next ,re ,name count ,endfun ,narrowfun)
+         ,@body)
        (put ',next-sym 'definition-name ',base)
        (defun ,prev-sym (&optional count)
         ,(format "Go to the previous COUNT'th %s.
-Interactively, COUNT is the prefix numeric argument, and defaults to 1."
-                  (or name base-name))
+Interactively, COUNT is the prefix numeric argument, and defaults to 1." name)
         (interactive "p")
-        (unless count (setq count 1))
-        (if (< count 0) (,next-sym (- count))
-           ,(funcall when-narrowed
-             `(unless (re-search-backward ,re nil t count)
-                (user-error "No previous %s" ,name)))
-           ,@body))
+         (easy-mmode--prev ,re ,name count ,endfun ,narrowfun)
+         ,@body)
        (put ',prev-sym 'definition-name ',base))))
 
 ;; When deleting these two, also delete them from loaddefs-gen.el.