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

diff --git a/lisp/derived.el b/lisp/derived.el
index 28b1a99bd2..3586affe21 100644
--- a/lisp/derived.el
+++ b/lisp/derived.el
@@ -81,7 +81,7 @@
 ;;
 ;;   (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-p' which can tell if the current
@@ -91,6 +91,24 @@
 
 ;;; 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
@@ -100,12 +118,13 @@
 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:
 
@@ -131,66 +150,58 @@ been generated automatically, with a reference to the keymap."
     (push docstring body)
     (setq docstring nil))
 
-  (unless parent (setq parent 'fundamental-mode))
+  (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-char-table 'syntax-table nil))
-       (defvar ,abbrev)
-       (define-abbrev-table ',abbrev nil)
+       (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.
-	 ;; (combine-run-hooks
+	 (delay-mode-hooks
 
-	  (,parent)
-					; Identify special modes.
-	  (if (get (quote ,parent) 'special)
-	      (put (quote ,child) 'special t))
+	  (,(or parent 'kill-all-local-variables))
 					; Identify the child mode.
 	  (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.
-	  (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)
 					; Splice in the body (if any).
 	  ,@body
-	  ;; )
+	  )
 					; Run the hooks, if any.
-	 (run-hooks ',hook)))))
-
-;; PUBLIC: find if the current mode derives from another.
-
-(defun derived-mode-p (&rest modes)
-  "Non-nil if the current major mode is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards."
-  (let ((parent major-mode))
-    (while (and (not (memq parent modes))
-		(setq parent (get parent 'derived-mode-parent))))
-    parent))
+	 (run-mode-hooks ',hook)))))
 
 ;; PUBLIC: find the ultimate class of a derived mode.
 
@@ -207,22 +218,6 @@ this function is not very useful.  Use `derived-mode-p' instead."
 
 ;;; PRIVATE
 
-(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")))
-
 (defun derived-mode-make-docstring (parent child &optional docstring)
   "Construct a docstring for a new mode if none is provided."
 
@@ -234,20 +229,23 @@ this function is not very useful.  Use `derived-mode-p' instead."
     (unless (stringp docstring)
       ;; Use a default docstring.
       (setq docstring
-	    (format "Major mode derived from `%s' by `define-derived-mode'.
+	    (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:
 
   `%s', `%s' and `%s'
 
 which more-or-less shadow %s's corresponding tables."
-		    parent map abbrev syntax parent)))
-  
+		      parent map abbrev syntax parent))))
+
     (unless (string-match (regexp-quote (symbol-name hook)) docstring)
       ;; Make sure the docstring mentions the mode's hook
       (setq docstring
 	    (concat docstring
-		    (if (eq parent 'fundamental-mode)
+		    (if (null parent)
 			"\n\nThis mode "
 		      (concat
 		       "\n\nIn addition to any hooks its parent mode "
@@ -257,7 +255,7 @@ which more-or-less shadow %s's corresponding tables."
 		       "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) "}")))
@@ -401,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