Mercurial > emacs

comparison lisp/emacs-lisp/easy-mmode.el @ 53733:d5f680b60b41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(easy-mmode-define-navigation): Use a more robust check of widening.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Tue, 27 Jan 2004 22:54:45 +0000
parents a9d324df91c7
children 15493a81cb78
comparison
equal deleted inserted replaced
53732:0341435e76ce 53733:d5f680b60b41
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, 2002, 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
431 NARROWFUN non-nil means to check for narrowing before moving, and if 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." 432 found, do widen first and then call NARROWFUN with no args after moving."
433 (let* ((base-name (symbol-name base)) 433 (let* ((base-name (symbol-name base))
434 (prev-sym (intern (concat base-name "-prev"))) 434 (prev-sym (intern (concat base-name "-prev")))
435 (next-sym (intern (concat base-name "-next"))) 435 (next-sym (intern (concat base-name "-next")))
436 (check-narrow-maybe (when narrowfun 436 (check-narrow-maybe
437 '(setq was-narrowed-p 437 (when narrowfun
438 (prog1 (or (/= (point-min) 1) 438 '(setq was-narrowed
439 (/= (point-max) 439 (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
440 (1+ (buffer-size)))) 440 (widen)))))
441 (widen)))))
442 (re-narrow-maybe (when narrowfun 441 (re-narrow-maybe (when narrowfun
443 `(when was-narrowed-p (,narrowfun))))) 442 `(when was-narrowed (,narrowfun)))))
444 (unless name (setq name base-name)) 443 (unless name (setq name base-name))
445 `(progn 444 `(progn
446 (add-to-list 'debug-ignored-errors 445 (add-to-list 'debug-ignored-errors
447 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) 446 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
448 (defun ,next-sym (&optional count) 447 (defun ,next-sym (&optional count)
449 ,(format "Go to the next COUNT'th %s." name) 448 ,(format "Go to the next COUNT'th %s." name)
450 (interactive) 449 (interactive)
451 (unless count (setq count 1)) 450 (unless count (setq count 1))
452 (if (< count 0) (,prev-sym (- count)) 451 (if (< count 0) (,prev-sym (- count))
453 (if (looking-at ,re) (setq count (1+ count))) 452 (if (looking-at ,re) (setq count (1+ count)))
454 (let (was-narrowed-p) 453 (let (was-narrowed)
455 ,check-narrow-maybe 454 ,check-narrow-maybe
456 (if (not (re-search-forward ,re nil t count)) 455 (if (not (re-search-forward ,re nil t count))
457 (if (looking-at ,re) 456 (if (looking-at ,re)
458 (goto-char (or ,(if endfun `(,endfun)) (point-max))) 457 (goto-char (or ,(if endfun `(,endfun)) (point-max)))
459 (error "No next %s" ,name)) 458 (error "No next %s" ,name))
470 (defun ,prev-sym (&optional count) 469 (defun ,prev-sym (&optional count)
471 ,(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))
472 (interactive) 471 (interactive)
473 (unless count (setq count 1)) 472 (unless count (setq count 1))
474 (if (< count 0) (,next-sym (- count)) 473 (if (< count 0) (,next-sym (- count))
475 (let (was-narrowed-p) 474 (let (was-narrowed)
476 ,check-narrow-maybe 475 ,check-narrow-maybe
477 (unless (re-search-backward ,re nil t count) 476 (unless (re-search-backward ,re nil t count)
478 (error "No previous %s" ,name)) 477 (error "No previous %s" ,name))
479 ,re-narrow-maybe)))))) 478 ,re-narrow-maybe))))))
480 479