;;; 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.
(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.