From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 9 Sep 2002 23:55:56 +0000 (+0000)
Subject: (define-derived-mode): Add keyword arguments.
X-Git-Tag: ttn-vms-21-2-B4~13277
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8e74e352d5993e4045a8a33fd4efe976770df005;p=emacs.git

(define-derived-mode): Add keyword arguments.
(derived-mode-make-docstring): Take abbrev and syntax table names.
---

diff --git a/lisp/derived.el b/lisp/derived.el
index 994509855e4..414f321552e 100644
--- a/lisp/derived.el
+++ b/lisp/derived.el
@@ -126,6 +126,17 @@ DOCSTRING: an optional documentation string--if you do not supply one,
 BODY:      forms to execute just before running the
            hooks for the new mode.  Do not use `interactive' here.
 
+BODY can start with a bunch of keyword arguments.  The following keyword
+  arguments are currently understood:
+:group GROUP
+	Declare the customization group that corresponds to this mode.
+:syntax-table TABLE
+	Use TABLE instead of the default.
+	A nil value means to simply use the same syntax-table as the parent.
+:abbrev-table TABLE
+	Use TABLE instead of the default.
+	A nil value means to simply use the same abbrev-table as the parent.
+
 Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
 
   (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
@@ -155,15 +166,31 @@ been generated automatically, with a reference to the keymap."
   (let ((map (derived-mode-map-name child))
 	(syntax (derived-mode-syntax-table-name child))
 	(abbrev (derived-mode-abbrev-table-name child))
+	(declare-abbrev t)
+	(declare-syntax t)
 	(hook (derived-mode-hook-name child))
-	(docstring (derived-mode-make-docstring parent child docstring)))
+	(group nil))
+
+    ;; Process the keyword args.
+    (while (keywordp (car body))
+      (case (pop body)
+	(:group (setq group (pop body)))
+	(:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
+	(:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))))
+
+
+    (setq docstring (derived-mode-make-docstring
+		     parent child docstring syntax abbrev))
 
     `(progn
        (defvar ,map (make-sparse-keymap))
-       (defvar ,syntax (make-syntax-table))
-       (defvar ,abbrev
-	 (progn (define-abbrev-table ',abbrev nil) ,abbrev))
+       ,(if declare-syntax
+	    `(defvar ,syntax (make-syntax-table)))
+       ,(if declare-abbrev
+	    `(defvar ,abbrev
+	       (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
        (put ',child 'derived-mode-parent ',parent)
+       ,(if group `(put ',child 'custom-group ,group))
 
        (defun ,child ()
 	 ,docstring
@@ -184,20 +211,25 @@ been generated automatically, with a reference to the keymap."
 					; 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))))
+		,(when declare-syntax
+		   `(let ((parent (char-table-parent ,syntax)))
+		      (unless (and parent
+				   (not (eq parent (standard-syntax-table))))
+			(set-char-table-parent ,syntax (syntax-table)))))
+		,(when declare-abbrev
+		   `(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)
+	  ,(when syntax `(set-syntax-table ,syntax))
+	  ,(when abbrev `(setq local-abbrev-table ,abbrev))
 					; Splice in the body (if any).
 	  ,@body
 	  )
@@ -220,12 +252,11 @@ is not very useful."
 
 ;;; PRIVATE
 
-(defun derived-mode-make-docstring (parent child &optional docstring)
+(defun derived-mode-make-docstring (parent child &optional
+					   docstring syntax abbrev)
   "Construct a docstring for a new mode if none is provided."
 
   (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)
@@ -244,7 +275,7 @@ which more-or-less shadow %s's corresponding tables."
 		      parent map abbrev syntax parent))))
 
     (unless (string-match (regexp-quote (symbol-name hook)) docstring)
-      ;; Make sure the docstring mentions the mode's hook
+      ;; Make sure the docstring mentions the mode's hook.
       (setq docstring
 	    (concat docstring
 		    (if (null parent)
@@ -259,7 +290,7 @@ which more-or-less shadow %s's corresponding tables."
 		    ", as the final step\nduring initialization.")))
 
     (unless (string-match "\\\\[{[]" docstring)
-      ;; And don't forget to put the mode's keymap
+      ;; And don't forget to put the mode's keymap.
       (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
 
     docstring))