X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f947a7faf04c8c2f9f10d1781648f2f8514f52a1..3c53a3cf83c218772d9bcfde4cd60c1face33e93:/lisp/derived.el

diff --git a/lisp/derived.el b/lisp/derived.el
index cdb3c505a0..3586affe21 100644
--- a/lisp/derived.el
+++ b/lisp/derived.el
@@ -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.
@@ -26,13 +26,6 @@
 
 ;;; 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
@@ -88,34 +81,50 @@
 ;;
 ;;   (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).
 
 ;;; 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)
 
 
-;; 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))
+
+
+;;; 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")))
 
 
 ;; 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))
-
 
 ;; 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