3 files changed, 85 insertions, 22 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 44130b804ad..5d0fb705d06 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2000-03-21  Stefan Monnier  <monnier@cs.yale.edu>
+
+        * derived.el (define-derived-mode): Don't autoload anymore.
+        Prefer the macro-only version provided by easy-mmode.el.
+
+        * emacs-lisp/easy-mmode.el (define-derived-mode): New name for
+        `easy-mmode-define-derived-mode'.
+        Use `combine-run-hooks'.
+        (easy-mmode-define-navigation): New macro.
+
+        * subr.el (combine-run-hooks): New function.
+
 2000-03-21  Kenichi HANDA  <handa@etl.go.jp>
 
         * term/x-win.el: Fontsets related initialization is simplified.
diff --git a/lisp/derived.el b/lisp/derived.el
index 2aa97b9d588..ee3b917b5d7 100644
--- a/lisp/derived.el
+++ b/lisp/derived.el
@@ -25,6 +25,13 @@
 
 ;;; Commentary:
 
+;; Obsolete.
+;; Use the `derived-major-mode' provided by easy-mmode.el instead.
+;; It is only kept for backward compatibility with byte-compiled files
+;; which refer to `derived-mode-init-mode-variables' and other functions.
+
+
+
 ;; GNU Emacs is already, in a sense, object oriented -- each object
 ;; (buffer) belongs to a class (major mode), and that class defines
 ;; the relationship between messages (input events) and methods
@@ -95,7 +102,7 @@
 
 ;; PUBLIC: define a new major mode which inherits from an existing one.
 
-;;;###autoload
+;; ;;;###autoload
 (defmacro define-derived-mode (child parent name &optional docstring &rest body)
   "Create a new mode as a variant of an existing mode.
 
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 069430a7aa6..edc0319c417 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -236,9 +236,13 @@ ARGS is a list of additional arguments."
 
 
 
+;;;
 ;;; A "macro-only" reimplementation of define-derived-mode.
+;;;
 
-(defmacro easy-mmode-define-derived-mode (child parent name &optional docstring &rest body)
+(defalias 'easy-mmode-define-derived-mode 'define-derived-mode)
+;;;###autoload
+(defmacro define-derived-mode (child parent name &optional docstring &rest body)
   "Create a new mode as a variant of an existing mode.
 
 The arguments to this command are as follow:
@@ -312,34 +316,74 @@ its own `%s' just before exiting."
          ,docstring
          (interactive)
                                         ; Run the parent.
-         (,parent)
+         (combine-run-hooks
+
+          (,parent)
                                         ; Identify special modes.
-         (put ',child 'special (get ',parent 'special))
+          (put ',child 'special (get ',parent 'special))
                                         ; Identify the child mode.
-         (setq major-mode ',child)
-         (setq mode-name ,name)
+          (setq major-mode ',child)
+          (setq mode-name ,name)
                                         ; Set up maps and tables.
-         (unless (keymap-parent ,map)
-           (set-keymap-parent ,map (current-local-map)))
-         (let ((parent (char-table-parent ,syntax)))
-           (unless (and parent (not (eq parent (standard-syntax-table))))
-             (set-char-table-parent ,syntax (syntax-table))))
-         (when local-abbrev-table
-           (mapatoms
-            (lambda (symbol)
-              (or (intern-soft (symbol-name symbol) ,abbrev)
-                  (define-abbrev ,abbrev (symbol-name symbol)
-                    (symbol-value symbol) (symbol-function symbol))))
-            local-abbrev-table))
+          (unless (keymap-parent ,map)
+            (set-keymap-parent ,map (current-local-map)))
+          (let ((parent (char-table-parent ,syntax)))
+            (unless (and parent (not (eq parent (standard-syntax-table))))
+              (set-char-table-parent ,syntax (syntax-table))))
+          (when local-abbrev-table
+            (mapatoms
+             (lambda (symbol)
+               (or (intern-soft (symbol-name symbol) ,abbrev)
+                   (define-abbrev ,abbrev (symbol-name symbol)
+                     (symbol-value symbol) (symbol-function symbol))))
+             local-abbrev-table))
        
-         (use-local-map ,map)
-         (set-syntax-table ,syntax)
-         (setq local-abbrev-table ,abbrev)
+          (use-local-map ,map)
+          (set-syntax-table ,syntax)
+          (setq local-abbrev-table ,abbrev)
                                         ; Splice in the body (if any).
-         ,@body
+          ,@body)
                                         ; Run the hooks, if any.
          (run-hooks ',hook)))))
 
+
+;;;
+;;; easy-mmode-define-navigation
+;;;
+
+(defmacro easy-mmode-define-navigation (base re &optional name endfun)
+  "Define BASE-next and BASE-prev to navigate in the buffer.
+RE determines the places the commands should move point to.
+NAME should describe the entities matched by RE and is used to build
+  the docstrings of the two functions.
+BASE-next also tries to make sure that the whole entry is visible by
+  searching for its end (by calling ENDFUN if provided or by looking for
+  the next entry) and recentering if necessary.
+ENDFUN should return the end position (with or without moving point)."
+  (let* ((base-name (symbol-name base))
+         (prev-sym (intern (concat base-name "-prev")))
+         (next-sym (intern (concat base-name "-next"))))
+    `(progn
+       (defun ,next-sym (&optional count)
+         ,(format "Go to the next COUNT'th %s." (or name base-name))
+         (interactive)
+         (unless count (setq count 1))
+         (if (< count 0) (,prev-sym (- count))
+           (if (looking-at ,re) (incf count))
+           (or (re-search-forward ,re nil t count) (ding))
+           (goto-char (match-beginning 0))
+           (when (eq (current-buffer) (window-buffer (selected-window)))
+             (let ((endpt (or (save-excursion
+                                ,(if endfun `(,endfun)
+                                   `(re-search-forward ,re nil t 2)))
+                              (point-max))))
+               (unless (<= endpt (window-end)) (recenter))))))
+       (defun ,prev-sym (&optional count)
+         ,(format "Go to the previous COUNT'th %s" (or name base-name))
+         (interactive)
+         (unless count (setq count 1))
+         (if (< count 0) (,next-sym (- count))
+           (or (re-search-backward ,re nil t count) (ding)))))))
 
 (provide 'easy-mmode)