Mercurial > emacs
comparison lisp/emacs-lisp/easy-mmode.el @ 89909:68c22ea6027c
Sync to HEAD
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Fri, 16 Apr 2004 12:51:06 +0000 |
parents | 375f2633d815 |
children | e24e2e78deda |
comparison
equal
deleted
inserted
replaced
89908:ee1402f7b568 | 89909:68c22ea6027c |
---|---|
1 ;;; easy-mmode.el --- easy definition for major and minor modes | 1 ;;; easy-mmode.el --- easy definition for major and minor modes |
2 | 2 |
3 ;; Copyright (C) 1997, 2000, 2001, 2003 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1997,2000,01,02,03,2004 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> | 5 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> |
6 ;; Maintainer: Stefan Monnier <monnier@gnu.org> | 6 ;; Maintainer: Stefan Monnier <monnier@gnu.org> |
7 | 7 |
8 ;; Keywords: extensions lisp | 8 ;; Keywords: extensions lisp |
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 | |
437 (when narrowfun | |
438 '(setq was-narrowed | |
439 (prog1 (or (< (- (point-max) (point-min)) (buffer-size))) | |
440 (widen))))) | |
441 (re-narrow-maybe (when narrowfun | |
442 `(when was-narrowed (,narrowfun))))) | |
434 (unless name (setq name base-name)) | 443 (unless name (setq name base-name)) |
435 `(progn | 444 `(progn |
436 (add-to-list 'debug-ignored-errors | 445 (add-to-list 'debug-ignored-errors |
437 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) | 446 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) |
438 (defun ,next-sym (&optional count) | 447 (defun ,next-sym (&optional count) |
439 ,(format "Go to the next COUNT'th %s." name) | 448 ,(format "Go to the next COUNT'th %s." name) |
440 (interactive) | 449 (interactive) |
441 (unless count (setq count 1)) | 450 (unless count (setq count 1)) |
442 (if (< count 0) (,prev-sym (- count)) | 451 (if (< count 0) (,prev-sym (- count)) |
443 (if (looking-at ,re) (incf count)) | 452 (if (looking-at ,re) (setq count (1+ count))) |
444 (if (not (re-search-forward ,re nil t count)) | 453 (let (was-narrowed) |
445 (if (looking-at ,re) | 454 ,check-narrow-maybe |
446 (goto-char (or ,(if endfun `(,endfun)) (point-max))) | 455 (if (not (re-search-forward ,re nil t count)) |
447 (error "No next %s" ,name)) | 456 (if (looking-at ,re) |
448 (goto-char (match-beginning 0)) | 457 (goto-char (or ,(if endfun `(,endfun)) (point-max))) |
449 (when (and (eq (current-buffer) (window-buffer (selected-window))) | 458 (error "No next %s" ,name)) |
450 (interactive-p)) | 459 (goto-char (match-beginning 0)) |
451 (let ((endpt (or (save-excursion | 460 (when (and (eq (current-buffer) (window-buffer (selected-window))) |
452 ,(if endfun `(,endfun) | 461 (interactive-p)) |
453 `(re-search-forward ,re nil t 2))) | 462 (let ((endpt (or (save-excursion |
454 (point-max)))) | 463 ,(if endfun `(,endfun) |
455 (unless (pos-visible-in-window-p endpt nil t) | 464 `(re-search-forward ,re nil t 2))) |
456 (recenter '(0)))))))) | 465 (point-max)))) |
466 (unless (pos-visible-in-window-p endpt nil t) | |
467 (recenter '(0)))))) | |
468 ,re-narrow-maybe))) | |
457 (defun ,prev-sym (&optional count) | 469 (defun ,prev-sym (&optional count) |
458 ,(format "Go to the previous COUNT'th %s" (or name base-name)) | 470 ,(format "Go to the previous COUNT'th %s" (or name base-name)) |
459 (interactive) | 471 (interactive) |
460 (unless count (setq count 1)) | 472 (unless count (setq count 1)) |
461 (if (< count 0) (,next-sym (- count)) | 473 (if (< count 0) (,next-sym (- count)) |
462 (unless (re-search-backward ,re nil t count) | 474 (let (was-narrowed) |
463 (error "No previous %s" ,name))))))) | 475 ,check-narrow-maybe |
476 (unless (re-search-backward ,re nil t count) | |
477 (error "No previous %s" ,name)) | |
478 ,re-narrow-maybe)))))) | |
479 | |
464 | 480 |
465 (provide 'easy-mmode) | 481 (provide 'easy-mmode) |
466 | 482 |
483 ;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a | |
467 ;;; easy-mmode.el ends here | 484 ;;; easy-mmode.el ends here |