Mercurial > emacs

--- a/lisp/derived.el	Mon Nov 29 23:03:09 1999 +0000
+++ b/lisp/derived.el	Mon Nov 29 23:16:47 1999 +0000
@@ -1,7 +1,7 @@
 ;;; derived.el --- allow inheritance of major modes.
 ;;; (formerly mode-clone.el)

-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1999 Free Software Foundation, Inc.

 ;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
 ;; Maintainer: FSF
@@ -70,12 +70,6 @@
 ;; - assign the value 'hypertext-mode' to the 'major-mode' variable
 ;; - run the body of commands provided in the macro -- in this case,
 ;;   set the local variable `case-fold-search' to nil.
-;; - **run the command (hypertext-mode-setup), which is empty by
-;;   default, but may be redefined by the user to contain special
-;;   commands (ie. setting local variables like 'outline-regexp')
-;;   **NOTE: do not use this option -- it will soon be obsolete.
-;; - run anything assigned to 'hypertext-mode-hook' (obsolete, but
-;;   supported for the sake of compatibility).
 ;;
 ;; The advantages of this system are threefold.  First, text mode is
 ;; untouched -- if you had added the new keystroke to `text-mode-map,'
@@ -108,8 +102,8 @@
 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 (ie. text-mode).
-NAME:      a string which will appear in the status line (ie. \"Hypertext\")
+PARENT:    the name of the command for the parent mode (e.g. `text-mode').
+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
@@ -123,7 +117,7 @@
 without changing regular LaTeX mode.  In this example, BODY is empty,
 and DOCSTRING is generated by default.

-On a more complicated level, the following command uses sgml-mode as
+On a more complicated level, the following command uses `sgml-mode' as
 the parent, and then sets the variable `case-fold-search' to nil:

   (define-derived-mode article-mode sgml-mode \"Article\"
@@ -142,38 +136,37 @@
 	     (setq docstring nil)))
   (setq docstring (or docstring (derived-mode-make-docstring parent child)))

-  (` (progn
-       (derived-mode-init-mode-variables '(, child))
-       (put '(, child) 'derived-mode-parent '(, parent))
-       (defun (, child) ()
-	 (, docstring)
-	 (interactive)
+  `(progn
+     (derived-mode-init-mode-variables (quote ,child))
+     (defun ,child ()
+       ,docstring
+       (interactive)
 					; Run the parent.
-	 ((, parent))
+       (,parent)
 					; Identify special modes.
-	 (if (get '(, parent) 'special)
-	     (put '(, child) 'special t))
+       (if (get (quote ,parent) 'special)
+	   (put (quote ,child) 'special t))
 					; Identify the child mode.
-	 (setq major-mode '(, child))
-	 (setq mode-name (, name))
+       (setq major-mode (quote ,child))
+       (setq mode-name ,name)
 					; Set up maps and tables.
-	 (derived-mode-set-keymap '(, child))
-	 (derived-mode-set-syntax-table '(, child))
-	 (derived-mode-set-abbrev-table '(, child))
+       (derived-mode-set-keymap (quote ,child))
+       (derived-mode-set-syntax-table (quote ,child))
+       (derived-mode-set-abbrev-table (quote ,child))
 					; Splice in the body (if any).
-	 (,@ body)
+       ,@body
 ;;;					; Run the setup function, if
 ;;;					; any -- this will soon be
 ;;;					; obsolete.
-;;;	 (derived-mode-run-setup-function '(, child))
-					; Run the hook, if any.
-	 (derived-mode-run-hooks '(, child))))))
+;;;	 (derived-mode-run-setup-function (quote ,child))
+					; Run the hooks, if any.
+       (derived-mode-run-hooks (quote ,child)))))


 ;; PUBLIC: find the ultimate class of a derived mode.

 (defun derived-mode-class (mode)
-  "Find the class of a major 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."
   (while (get mode 'derived-mode-parent)
@@ -184,7 +177,7 @@
 ;; Inline functions to construct various names from a mode name.

 (defsubst derived-mode-setup-function-name (mode)
-  "Construct a setup-function name based on a mode name."
+  "Construct a setup-function name based on a MODE name."
   (intern (concat (symbol-name mode) "-setup")))

 (defsubst derived-mode-hook-name (mode)
@@ -192,15 +185,15 @@
   (intern (concat (symbol-name mode) "-hook")))

 (defsubst derived-mode-map-name (mode)
-  "Construct a map name based on a mode name."
+  "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."
+  "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."
+  "Construct an abbrev-table name based on a MODE name."
   (intern (concat (symbol-name mode) "-abbrev-table")))


@@ -208,34 +201,35 @@

 ;;;###autoload
 (defun derived-mode-init-mode-variables (mode)
-  "Initialise variables for a new mode.
+  "Initialise variables for a new MODE.
 Right now, if they don't already exist, set up a blank keymap, an
 empty syntax table, and an empty abbrev table -- these will be merged
 the first time the mode is used."

   (if (boundp (derived-mode-map-name mode))
       t
-    (eval (` (defvar (, (derived-mode-map-name mode))
+    (eval `(defvar ,(derived-mode-map-name mode)
 	       (make-sparse-keymap)
-	       (, (format "Keymap for %s." mode)))))
+	       ,(format "Keymap for %s." mode)))
     (put (derived-mode-map-name mode) 'derived-mode-unmerged t))

   (if (boundp (derived-mode-syntax-table-name mode))
       t
-    (eval (` (defvar (, (derived-mode-syntax-table-name mode))
-	       ;; Make a syntax table which doesn't specify anything
-	       ;; for any char.  Valid data will be merged in by
-	       ;; derived-mode-merge-syntax-tables.
-	       (make-char-table 'syntax-table nil)
-	       (, (format "Syntax table for %s." mode)))))
+    (eval `(defvar ,(derived-mode-syntax-table-name mode)
+	     ;; Make a syntax table which doesn't specify anything
+	     ;; for any char.  Valid data will be merged in by
+	     ;; derived-mode-merge-syntax-tables.
+	     (make-char-table 'syntax-table nil)
+	     ,(format "Syntax table for %s." mode)))
     (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))

   (if (boundp (derived-mode-abbrev-table-name mode))
       t
-    (eval (` (defvar (, (derived-mode-abbrev-table-name mode))
-	       (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
-		      (make-abbrev-table))
-	       (, (format "Abbrev table for %s." mode)))))))
+    (eval `(defvar ,(derived-mode-abbrev-table-name mode)
+	     (progn
+	       (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."
@@ -256,7 +250,7 @@
 ;; Utility functions for running a derived mode.

 (defun derived-mode-set-keymap (mode)
-  "Set the keymap of the new mode, maybe merging with the parent."
+  "Set the keymap of the new MODE, maybe merging with the parent."
   (let* ((map-name (derived-mode-map-name mode))
 	 (new-map (eval map-name))
 	 (old-map (current-local-map)))
@@ -266,8 +260,8 @@
     (put map-name 'derived-mode-unmerged nil)
     (use-local-map new-map)))

-(defun derived-mode-set-syntax-table (mode)
-  "Set the syntax table of the new mode, maybe merging with the parent."
+(defun derived-mode-set-syntax-table (mode)
+  "Set the syntax table of the new MODE, maybe merging with the parent."
   (let* ((table-name (derived-mode-syntax-table-name mode))
 	 (old-table (syntax-table))
 	 (new-table (eval table-name)))
@@ -277,7 +271,7 @@
     (set-syntax-table new-table)))

 (defun derived-mode-set-abbrev-table (mode)
-  "Set the abbrev table if it exists.
+  "Set the abbrev table for MODE if it exists.
 Always merge its parent into it, since the merge is non-destructive."
   (let* ((table-name (derived-mode-abbrev-table-name mode))
 	 (old-table local-abbrev-table)
@@ -302,9 +296,10 @@
 ;; Functions to merge maps and tables.

 (defun derived-mode-merge-keymaps (old new)
-  "Merge an old keymap into a new one.
+  "Merge an OLD keymap into a NEW one.
 The old keymap is set to be the last cdr of the new one, so that there will
 be automatic inheritance."
+  ;; ?? Can this just use `set-keymap-parent'?
   (let ((tail new))
     ;; Scan the NEW map for prefix keys.
     (while (consp tail)
@@ -330,7 +325,7 @@
   (setcdr (nthcdr (1- (length new)) new) old))

 (defun derived-mode-merge-syntax-tables (old new)
-  "Merge an old syntax table into a new one.
+  "Merge an OLD syntax table into a NEW one.
 Where the new table already has an entry, nothing is copied from the old one."
   (set-char-table-parent new old))

@@ -340,12 +335,11 @@
 ;; as the value of the symbol, and the hook as the function definition.
 (defun derived-mode-merge-abbrev-tables (old new)
   (if old
-      (mapatoms
-       (function
-	(lambda (symbol)
-	  (or (intern-soft (symbol-name symbol) new)
-	      (define-abbrev new (symbol-name symbol)
-		(symbol-value symbol) (symbol-function symbol)))))
+      (mapatoms
+       (lambda (symbol)
+	 (or (intern-soft (symbol-name symbol) new)
+	     (define-abbrev new (symbol-name symbol)
+	       (symbol-value symbol) (symbol-function symbol))))
        old)))

 (provide 'derived)