comparison lisp/emacs-lisp/easy-mmode.el @ 53056:a9d324df91c7

(easy-mmode-define-navigation): Take additional optional arg NARROWFUN. For the generated functions: Add local var `was-narrowed-p'. Also, if NARROWFUN is specified, include frags that arrange to check for and save narrowing state before the move and then conditionally call NARROWFUN after the move.
author Thien-Thi Nguyen <ttn@gnuvola.org>
date Fri, 14 Nov 2003 16:16:31 +0000
parents a2ef3d8f83d4
children d5f680b60b41
comparison
equal deleted inserted replaced
53055:4cb0d5b004e9 53056:a9d324df91c7
417 417
418 ;;; 418 ;;;
419 ;;; easy-mmode-define-navigation 419 ;;; easy-mmode-define-navigation
420 ;;; 420 ;;;
421 421
422 (defmacro easy-mmode-define-navigation (base re &optional name endfun) 422 (defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun)
423 "Define BASE-next and BASE-prev to navigate in the buffer. 423 "Define BASE-next and BASE-prev to navigate in the buffer.
424 RE determines the places the commands should move point to. 424 RE determines the places the commands should move point to.
425 NAME should describe the entities matched by RE. It is used to build 425 NAME should describe the entities matched by RE. It is used to build
426 the docstrings of the two functions. 426 the docstrings of the two functions.
427 BASE-next also tries to make sure that the whole entry is visible by 427 BASE-next also tries to make sure that the whole entry is visible by
428 searching for its end (by calling ENDFUN if provided or by looking for 428 searching for its end (by calling ENDFUN if provided or by looking for
429 the next entry) and recentering if necessary. 429 the next entry) and recentering if necessary.
430 ENDFUN should return the end position (with or without moving point)." 430 ENDFUN should return the end position (with or without moving point).
431 NARROWFUN non-nil means to check for narrowing before moving, and if
432 found, do widen first and then call NARROWFUN with no args after moving."
431 (let* ((base-name (symbol-name base)) 433 (let* ((base-name (symbol-name base))
432 (prev-sym (intern (concat base-name "-prev"))) 434 (prev-sym (intern (concat base-name "-prev")))
433 (next-sym (intern (concat base-name "-next")))) 435 (next-sym (intern (concat base-name "-next")))
436 (check-narrow-maybe (when narrowfun
437 '(setq was-narrowed-p
438 (prog1 (or (/= (point-min) 1)
439 (/= (point-max)
440 (1+ (buffer-size))))
441 (widen)))))
442 (re-narrow-maybe (when narrowfun
443 `(when was-narrowed-p (,narrowfun)))))
434 (unless name (setq name base-name)) 444 (unless name (setq name base-name))
435 `(progn 445 `(progn
436 (add-to-list 'debug-ignored-errors 446 (add-to-list 'debug-ignored-errors
437 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) 447 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
438 (defun ,next-sym (&optional count) 448 (defun ,next-sym (&optional count)
439 ,(format "Go to the next COUNT'th %s." name) 449 ,(format "Go to the next COUNT'th %s." name)
440 (interactive) 450 (interactive)
441 (unless count (setq count 1)) 451 (unless count (setq count 1))
442 (if (< count 0) (,prev-sym (- count)) 452 (if (< count 0) (,prev-sym (- count))
443 (if (looking-at ,re) (setq count (1+ count))) 453 (if (looking-at ,re) (setq count (1+ count)))
444 (if (not (re-search-forward ,re nil t count)) 454 (let (was-narrowed-p)
445 (if (looking-at ,re) 455 ,check-narrow-maybe
446 (goto-char (or ,(if endfun `(,endfun)) (point-max))) 456 (if (not (re-search-forward ,re nil t count))
447 (error "No next %s" ,name)) 457 (if (looking-at ,re)
448 (goto-char (match-beginning 0)) 458 (goto-char (or ,(if endfun `(,endfun)) (point-max)))
449 (when (and (eq (current-buffer) (window-buffer (selected-window))) 459 (error "No next %s" ,name))
450 (interactive-p)) 460 (goto-char (match-beginning 0))
451 (let ((endpt (or (save-excursion 461 (when (and (eq (current-buffer) (window-buffer (selected-window)))
452 ,(if endfun `(,endfun) 462 (interactive-p))
453 `(re-search-forward ,re nil t 2))) 463 (let ((endpt (or (save-excursion
454 (point-max)))) 464 ,(if endfun `(,endfun)
455 (unless (pos-visible-in-window-p endpt nil t) 465 `(re-search-forward ,re nil t 2)))
456 (recenter '(0)))))))) 466 (point-max))))
467 (unless (pos-visible-in-window-p endpt nil t)
468 (recenter '(0))))))
469 ,re-narrow-maybe)))
457 (defun ,prev-sym (&optional count) 470 (defun ,prev-sym (&optional count)
458 ,(format "Go to the previous COUNT'th %s" (or name base-name)) 471 ,(format "Go to the previous COUNT'th %s" (or name base-name))
459 (interactive) 472 (interactive)
460 (unless count (setq count 1)) 473 (unless count (setq count 1))
461 (if (< count 0) (,next-sym (- count)) 474 (if (< count 0) (,next-sym (- count))
462 (unless (re-search-backward ,re nil t count) 475 (let (was-narrowed-p)
463 (error "No previous %s" ,name))))))) 476 ,check-narrow-maybe
477 (unless (re-search-backward ,re nil t count)
478 (error "No previous %s" ,name))
479 ,re-narrow-maybe))))))
480
464 481
465 (provide 'easy-mmode) 482 (provide 'easy-mmode)
466 483
467 ;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a 484 ;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a
468 ;;; easy-mmode.el ends here 485 ;;; easy-mmode.el ends here