]> code.delx.au - gnu-emacs/blobdiff - lisp/derived.el
Delete the autoloads for functions defined with ibuffer-specific commands.
[gnu-emacs] / lisp / derived.el
index cdb3c505a01510022ffb26a751a9c46f0ab4718f..3586affe216448ac04b093d779833ae6b6786fbe 100644 (file)
@@ -1,4 +1,4 @@
-;;; derived.el --- allow inheritance of major modes.
+;;; derived.el --- allow inheritance of major modes
 ;;; (formerly mode-clone.el)
 
 ;; Copyright (C) 1993, 1994, 1999 Free Software Foundation, Inc.
 \f
 ;;; 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
 ;;
 ;;   (define-derived-mode html-mode hypertext-mode "HTML")
 ;;   [various key definitions]
-;; 
-;; will add a new major mode for HTML with very little fuss.
 ;;
-;; Note also the function `derived-mode-class,' which returns the non-derived
-;; major mode which a derived mode is based on (ie. NOT necessarily the
-;; immediate parent).
+;; will add a new major mode for HTML with very little fuss.
 ;;
-;; (derived-mode-class 'text-mode) ==> text-mode
-;; (derived-mode-class 'hypertext-mode) ==> text-mode
-;; (derived-mode-class 'html-mode) ==> text-mode
+;; Note also the function `derived-mode-p' which can tell if the current
+;; mode derives from another.  In a hypertext-mode, buffer, for example,
+;; (derived-mode-p 'text-mode) would return non-nil.  This should always
+;; be used in place of (eq major-mode 'text-mode).
 \f
 ;;; Code:
 
+;;; PRIVATE: defsubst must be defined before they are first used
+
+(defsubst derived-mode-hook-name (mode)
+  "Construct the mode hook name based on mode name MODE."
+  (intern (concat (symbol-name mode) "-hook")))
+
+(defsubst derived-mode-map-name (mode)
+  "Construct a map name based on a MODE name."
+  (intern (concat (symbol-name mode) "-map")))
+
+(defsubst derived-mode-syntax-table-name (mode)
+  "Construct a syntax-table name based on a MODE name."
+  (intern (concat (symbol-name mode) "-syntax-table")))
+
+(defsubst derived-mode-abbrev-table-name (mode)
+  "Construct an abbrev-table name based on a MODE name."
+  (intern (concat (symbol-name mode) "-abbrev-table")))
+
 ;; 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.
 
 The arguments to this command are as follow:
 
 CHILD:     the name of the command for the derived mode.
-PARENT:    the name of the command for the parent mode (e.g. `text-mode').
+PARENT:    the name of the command for the parent mode (e.g. `text-mode')
+           or nil if there is no parent.
 NAME:      a string which will appear in the status line (e.g. \"Hypertext\")
 DOCSTRING: an optional documentation string--if you do not supply one,
            the function will attempt to invent something useful.
 BODY:      forms to execute just before running the
-           hooks for the new mode.
+           hooks for the new mode.  Do not use `interactive' here.
 
 Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
 
@@ -135,74 +144,132 @@ the parent, and then sets the variable `case-fold-search' to nil:
 Note that if the documentation string had been left out, it would have
 been generated automatically, with a reference to the keymap."
 
-                                       ; Some trickiness, since what
-                                       ; appears to be the docstring
-                                       ; may really be the first
-                                       ; element of the body.
-  (if (and docstring (not (stringp docstring)))
-      (progn (setq body (cons docstring body))
-            (setq docstring nil)))
-  (setq docstring (or docstring (derived-mode-make-docstring parent child)))
-
-  `(progn
-     (derived-mode-init-mode-variables (quote ,child))
-     (defun ,child ()
-       ,docstring
-       (interactive)
+  (when (and docstring (not (stringp docstring)))
+    ;; Some trickiness, since what appears to be the docstring may really be
+    ;; the first element of the body.
+    (push docstring body)
+    (setq docstring nil))
+
+  (when (eq parent 'fundamental-mode) (setq parent nil))
+
+  (let ((map (derived-mode-map-name child))
+       (syntax (derived-mode-syntax-table-name child))
+       (abbrev (derived-mode-abbrev-table-name child))
+       (hook (derived-mode-hook-name child))
+       (docstring (derived-mode-make-docstring parent child docstring)))
+
+    `(progn
+       (defvar ,map (make-sparse-keymap))
+       (defvar ,syntax (make-syntax-table))
+       (defvar ,abbrev
+        (progn (define-abbrev-table ',abbrev nil) ,abbrev))
+       (put ',child 'derived-mode-parent ',parent)
+
+       (defun ,child ()
+        ,docstring
+        (interactive)
                                        ; Run the parent.
-       (,parent)
-                                       ; Identify special modes.
-       (if (get (quote ,parent) 'special)
-          (put (quote ,child) 'special t))
+        (delay-mode-hooks
+
+         (,(or parent 'kill-all-local-variables))
                                        ; Identify the child mode.
-       (setq major-mode (quote ,child))
-       (setq mode-name ,name)
+         (setq major-mode (quote ,child))
+         (setq mode-name ,name)
+                                       ; Identify special modes.
+         ,(when parent
+            `(progn
+               (if (get (quote ,parent) 'special)
+                   (put (quote ,child) 'special t))
                                        ; Set up maps and tables.
-       (derived-mode-set-keymap (quote ,child))
-       (derived-mode-set-syntax-table (quote ,child))
-       (derived-mode-set-abbrev-table (quote ,child))
+               (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)
                                        ; Splice in the body (if any).
-       ,@body
-;;;                                    ; Run the setup function, if
-;;;                                    ; any -- this will soon be
-;;;                                    ; obsolete.
-;;;     (derived-mode-run-setup-function (quote ,child))
+         ,@body
+         )
                                        ; Run the hooks, if any.
-       (derived-mode-run-hooks (quote ,child)))))
-
+        (run-mode-hooks ',hook)))))
 
 ;; PUBLIC: find the ultimate class of a derived mode.
 
 (defun derived-mode-class (mode)
   "Find the class of a major MODE.
 A mode's class is the first ancestor which is NOT a derived mode.
-Use the `derived-mode-parent' property of the symbol to trace backwards."
+Use the `derived-mode-parent' property of the symbol to trace backwards.
+Since major-modes might derive from each other and from `fundamental-mode',
+this function is not very useful.  Use `derived-mode-p' instead."
   (while (get mode 'derived-mode-parent)
     (setq mode (get mode 'derived-mode-parent)))
   mode)
 
 \f
-;; Inline functions to construct various names from a mode name.
+;;; PRIVATE
 
-(defsubst derived-mode-setup-function-name (mode)
-  "Construct a setup-function name based on a MODE name."
-  (intern (concat (symbol-name mode) "-setup")))
+(defun derived-mode-make-docstring (parent child &optional docstring)
+  "Construct a docstring for a new mode if none is provided."
 
-(defsubst derived-mode-hook-name (mode)
-  "Construct the mode hook name based on mode name MODE."
-  (intern (concat (symbol-name mode) "-hook")))
+  (let ((map (derived-mode-map-name child))
+       (syntax (derived-mode-syntax-table-name child))
+       (abbrev (derived-mode-abbrev-table-name child))
+       (hook (derived-mode-hook-name child)))
+
+    (unless (stringp docstring)
+      ;; Use a default docstring.
+      (setq docstring
+           (if (null parent)
+               (format "Major-mode.
+Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
+             (format "Major mode derived from `%s' by `define-derived-mode'.
+It inherits all of the parent's attributes, but has its own keymap,
+abbrev table and syntax table:
 
-(defsubst derived-mode-map-name (mode)
-  "Construct a map name based on a MODE name."
-  (intern (concat (symbol-name mode) "-map")))
+  `%s', `%s' and `%s'
 
-(defsubst derived-mode-syntax-table-name (mode)
-  "Construct a syntax-table name based on a MODE name."
-  (intern (concat (symbol-name mode) "-syntax-table")))
+which more-or-less shadow %s's corresponding tables."
+                     parent map abbrev syntax parent))))
 
-(defsubst derived-mode-abbrev-table-name (mode)
-  "Construct an abbrev-table name based on a MODE name."
-  (intern (concat (symbol-name mode) "-abbrev-table")))
+    (unless (string-match (regexp-quote (symbol-name hook)) docstring)
+      ;; Make sure the docstring mentions the mode's hook
+      (setq docstring
+           (concat docstring
+                   (if (null parent)
+                       "\n\nThis mode "
+                     (concat
+                      "\n\nIn addition to any hooks its parent mode "
+                      (if (string-match (regexp-quote (format "`%s'" parent))
+                                        docstring) nil
+                        (format "`%s' " parent))
+                      "might have run,\nthis mode "))
+                   (format "runs the hook `%s'" hook)
+                   ", as the final step\nduring initialization.")))
+
+    (unless (string-match "\\\\[{[]" docstring)
+      ;; And don't forget to put the mode's keymap
+      (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
+
+    docstring))
+
+\f
+;;; OBSOLETE
+;; The functions below are only provided for backward compatibility with
+;; code byte-compiled with versions of derived.el prior to Emacs-21.
+
+(defsubst derived-mode-setup-function-name (mode)
+  "Construct a setup-function name based on a MODE name."
+  (intern (concat (symbol-name mode) "-setup")))
 
 \f
 ;; Utility functions for defining a derived mode.
@@ -238,22 +305,6 @@ the first time the mode is used."
               (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
               (make-abbrev-table))
             ,(format "Abbrev table for %s." mode)))))
-
-(defun derived-mode-make-docstring (parent child)
-  "Construct a docstring for a new mode if none is provided."
-
-  (format "This major mode is a variant of `%s', created by `define-derived-mode'.
-It inherits all of the parent's attributes, but has its own keymap,
-abbrev table and syntax table:
-
-  `%s-map' and `%s-syntax-table'
-
-which more-or-less shadow
-
-  `%s-map' and `%s-syntax-table'
-
-\\{%s-map}" parent child child parent parent child))
-
 \f
 ;; Utility functions for running a derived mode.
 
@@ -296,7 +347,6 @@ Always merge its parent into it, since the merge is non-destructive."
 
 (defun derived-mode-run-hooks (mode)
   "Run the mode hook for MODE."
-
   (let ((hooks-name (derived-mode-hook-name mode)))
     (if (boundp hooks-name)
        (run-hooks hooks-name))))
@@ -349,7 +399,7 @@ Where the new table already has an entry, nothing is copied from the old one."
             (define-abbrev new (symbol-name symbol)
               (symbol-value symbol) (symbol-function symbol))))
        old)))
-    
+
 (provide 'derived)
 
 ;;; derived.el ends here