summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSpencer Baugh <sbaugh@janestreet.com>2024-09-10 13:46:18 -0400
committerDmitry Gutov <dmitry@gutov.dev>2024-09-27 04:25:54 +0300
commitda1416fc6998718d1e36e32961b4415045949632 (patch)
tree21bfebba7ac1a0de2a32a6d1aea816a86fe131cc
parentc95620ffbf8c2caebdb6a7aba7dbe9cd223fa2f4 (diff)
Move easy-mmode-define-navigation logic to helper functions
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.
-rw-r--r--lisp/emacs-lisp/easy-mmode.el86
1 files changed, 49 insertions, 37 deletions
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index a140027839e..d3dcab899d6 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -763,6 +763,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.
@@ -780,53 +822,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.