[bpt/emacs.git] / lisp / emacs-lisp / easy-mmode.el

;;; easy-mmode.el --- easy definition for major and minor modes.

;; Copyright (C) 1997  Free Software Foundation, Inc.

;; Author:  Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer:  Stefan Monnier <monnier@gnu.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Minor modes are useful and common.  This package makes defining a
;; minor mode easy, by focusing on the writing of the minor mode
;; functionalities themselves.  Moreover, this package enforces a
;; conventional naming of user interface primitives, making things
;; natural for the minor-mode end-users.

;; For each mode, easy-mmode defines the following:
;; <mode>      : The minor mode predicate. A buffer-local variable.
;; <mode>-map  : The keymap possibly associated to <mode>.
;; <mode>-hook,<mode>-on-hook,<mode>-off-hook and <mode>-mode:
;;       see `easy-mmode-define-minor-mode' documentation
;;
;; eval
;;  (pp (macroexpand '(easy-mmode-define-minor-mode <your-mode> <doc>)))
;; to check the result before using it.

;; The order in which minor modes are installed is important.  Keymap
;; lookup proceeds down minor-mode-map-alist, and the order there
;; tends to be the reverse of the order in which the modes were
;; installed.  Perhaps there should be a feature to let you specify
;; orderings.

;; Additionally to `define-minor-mode', the package provides convenient
;; ways to define keymaps, and other helper functions for major and minor modes.

;;; Code:

(defmacro easy-mmode-define-toggle (mode &optional doc &rest body)
  "Define a one arg toggle mode MODE function and associated hooks.
MODE is the so defined function that toggles the mode.
optional DOC is its associated documentation.
BODY is executed after the toggling and before running the hooks.

Hooks are checked for run, each time MODE-mode is called.
They run under the followings conditions:
MODE-hook: if the mode is toggled.
MODE-on-hook: if the mode is on.
MODE-off-hook: if the mode is off.

When the mode is effectively toggled, two hooks may run.
If so MODE-hook is guaranteed to be the first."
  (let* ((mode-name (symbol-name mode))
	 (hook (intern (concat mode-name "-hook")))
	 (hook-on (intern (concat mode-name "-on-hook")))
	 (hook-off (intern (concat mode-name "-off-hook")))
	 (toggle-doc (or doc
			 (format "With no argument, toggle %s.
With universal prefix ARG turn mode on.
With zero or negative ARG turn mode off.
\\{%s}" mode-name (concat mode-name "-map")))))
    `(progn
       (defcustom ,hook  nil
	 ,(format "Hook called when `%s' is toggled" mode-name)
	 :type 'hook)

       (defcustom ,hook-on  nil
	 ,(format "Hook called when `%s' is turned on" mode-name)
	 :type 'hook)

       (defcustom ,hook-off nil
	 ,(format "Hook called when `%s' is turned off" mode-name)
	 :type 'hook)

       (defun ,mode (&optional arg)
	 ,toggle-doc
	 (interactive "P")
	 (let ((old-mode ,mode))
	   (setq ,mode
		 (if arg
		     (> (prefix-numeric-value arg) 0)
		   (not ,mode)))
	   ,@body
	   (unless (equal old-mode ,mode) (run-hooks ',hook))
	   (run-hooks (if ,mode ',hook-on ',hook-off)))))))

;;;###autoload
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
  "Define a new minor mode MODE.
This function defines the associated control variable, keymap,
toggle command, and hooks (see `easy-mmode-define-toggle').

DOC is the documentation for the mode toggle command.
Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the mode-bar when the mode is on.
Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
If it is a list, it is passed to `easy-mmode-define-keymap'
in order to build a valid keymap.
BODY contains code that will be executed each time the mode is (dis)activated.
It will be executed after any toggling but before running the hooks."
  (let* ((mode-name (symbol-name mode))
	 (mode-doc (format "Non-nil if mode is enabled.
Use the function `%s' to change this variable." mode-name))
	 (keymap-sym (intern (concat mode-name "-map")))
	 (keymap-doc (format "Keymap for `%s'." mode-name)))
    `(progn
       ;; Define the variable to enable or disable the mode.
       (defvar ,mode ,init-value ,mode-doc)
       (make-variable-buffer-local ',mode)

       ;; Define the minor-mode keymap.
       ,(when keymap
	  `(defvar ,keymap-sym
	     (cond ((and ,keymap (keymapp ,keymap))
		    ,keymap)
		   ((listp ,keymap)
		    (easy-mmode-define-keymap ,keymap))
		   (t (error "Invalid keymap %S" ,keymap)))
	     ,keymap-doc))

       ;; Define the toggle and the hooks.
       (easy-mmode-define-toggle ,mode ,doc ,@body)

       ;; Update the mode line.
       (or (assq ',mode minor-mode-alist)
	   (setq minor-mode-alist
		 (cons (list ',mode nil) minor-mode-alist)))
       (setcar (cdr (assq ',mode minor-mode-alist)) ,lighter)

       ;; Update the minor mode map.
       (or (assq ',mode minor-mode-map-alist)
	   (setq minor-mode-map-alist
		 (cons (cons ',mode nil) minor-mode-map-alist)))
       (setcdr (assq ',mode minor-mode-map-alist)
	       ,keymap-sym)) ))

\f
;;;
;;; easy-mmode-defmap
;;;

(if (fboundp 'set-keymap-parents)
    (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
  (defun easy-mmode-set-keymap-parents (m parents)
    (set-keymap-parent
     m
     (cond
      ((not (consp parents)) parents)
      ((not (cdr parents)) (car parents))
      (t (let ((m (copy-keymap (pop parents))))
	   (easy-mmode-set-keymap-parents m parents)
	   m))))))

(defun easy-mmode-define-keymap (bs &optional name m args)
  "Return a keymap built from bindings BS.
BS must be a list of (KEY . BINDING) where
KEY and BINDINGS are suited as for define-key.
optional NAME is passed to `make-sparse-keymap'.
optional map M can be used to modify an existing map.
ARGS is a list of additional arguments."
  (let (inherit dense suppress)
    (while args
      (let ((key (pop args))
	    (val (pop args)))
	(cond
	 ((eq key :dense) (setq dense val))
	 ((eq key :inherit) (setq inherit val))
	 ((eq key :group) )
	 ;;((eq key :suppress) (setq suppress val))
	 (t (message "Unknown argument %s in defmap" key)))))
    (unless (keymapp m)
      (setq bs (append m bs))
      (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
    (dolist (b bs)
      (let ((keys (car b))
	    (binding (cdr b)))
	(dolist (key (if (consp keys) keys (list keys)))
	  (cond
	   ((symbolp key)
	    (substitute-key-definition key binding m global-map))
	   ((null binding)
	    (unless (keymapp (lookup-key m key)) (define-key m key binding)))
	   ((let ((o (lookup-key m key)))
	      (or (null o) (numberp o) (eq o 'undefined)))
	    (define-key m key binding))))))
    (cond
     ((keymapp inherit) (set-keymap-parent m inherit))
     ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
    m))

;;;###autoload
(defmacro easy-mmode-defmap (m bs doc &rest args)
  `(progn
     (autoload 'easy-mmode-define-keymap "easy-mmode")
     (defconst ,m
       (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
       ,doc)))

\f
;;;
;;; easy-mmode-defsyntax
;;;

(defun easy-mmode-define-syntax (css args)
  (let ((st (make-syntax-table (cadr (memq :copy args)))))
    (dolist (cs css)
      (let ((char (car cs))
	    (syntax (cdr cs)))
	(if (sequencep char)
	    (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
	  (modify-syntax-entry char syntax st))))
    st))

;;;###autoload
(defmacro easy-mmode-defsyntax (st css doc &rest args)
  `(progn
     (autoload 'easy-mmode-define-syntax "easy-mmode")
     (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) doc)))


\f
;;; A "macro-only" reimplementation of define-derived-mode.

(defmacro easy-mmode-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').
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.

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\")

You could then make new key bindings for `LaTeX-thesis-mode-map'
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
the parent, and then sets the variable `case-fold-search' to nil:

  (define-derived-mode article-mode sgml-mode \"Article\"
    \"Major mode for editing technical articles.\"
    (setq case-fold-search nil))

Note that if the documentation string had been left out, it would have
been generated automatically, with a reference to the keymap."

  (let* ((child-name (symbol-name child))
	 (map (intern (concat child-name "-map")))
	 (syntax (intern (concat child-name "-syntax-table")))
	 (abbrev (intern (concat child-name "-abbrev-table")))
	 (hook (intern (concat child-name "-hook"))))
	 
    (when (and docstring (not (stringp docstring)))
      ;; DOCSTRING is really the first command and there's no docstring
      (push docstring body)
      (setq docstring nil))

    (unless (stringp docstring)
      ;; Use a default docstring.
      (setq docstring
	    (format "Major mode derived from `%s' by `define-derived-mode'.
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 syntax abbrev parent)))

    (unless (string-match (regexp-quote (symbol-name hook)) docstring)
      ;; Make sure the docstring mentions the mode's hook
      (setq docstring (format "%s
This mode runs (additionally to any hooks his parent might have run)
its own `%s' just before exiting."
			      docstring hook)))

    (unless (string-match "\\\\[{[]" docstring)
      ;; And don't forget to put the mode's keymap
      (setq docstring (concat docstring "\n\\{" (symbol-name map) "}")))

    `(progn
       (defvar ,map (make-sparse-keymap))
       (defvar ,syntax (make-char-table 'syntax-table nil))
       (defvar ,abbrev (progn (define-abbrev-table ',abbrev nil) ,abbrev))
     
       (defun ,child ()
	 ,docstring
	 (interactive)
					; Run the parent.
	 (,parent)
					; Identify special modes.
	 (put ',child 'special (get ',parent 'special))
					; Identify the child mode.
	 (setq major-mode ',child)
	 (setq mode-name ,name)
					; 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))
       
	 (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)))))


(provide 'easy-mmode)

;;; easy-mmode.el ends here
Commit	Line	Data
5a7a545c	1	;;; easy-mmode.el --- easy definition for major and minor modes.
6b279740 RS	2
	3	;; Copyright (C) 1997 Free Software Foundation, Inc.
	4
	5	;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
29cc3b84	6	;; Maintainer: Stefan Monnier <monnier@gnu.org>
6b279740 RS	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
	24
	25	;;; Commentary:
	26
	27	;; Minor modes are useful and common. This package makes defining a
	28	;; minor mode easy, by focusing on the writing of the minor mode
	29	;; functionalities themselves. Moreover, this package enforces a
	30	;; conventional naming of user interface primitives, making things
	31	;; natural for the minor-mode end-users.
	32
	33	;; For each mode, easy-mmode defines the following:
	34	;; <mode> : The minor mode predicate. A buffer-local variable.
	35	;; <mode>-map : The keymap possibly associated to <mode>.
	36	;; <mode>-hook,<mode>-on-hook,<mode>-off-hook and <mode>-mode:
	37	;; see `easy-mmode-define-minor-mode' documentation
	38	;;
	39	;; eval
	40	;; (pp (macroexpand '(easy-mmode-define-minor-mode <your-mode> <doc>)))
	41	;; to check the result before using it.
	42
	43	;; The order in which minor modes are installed is important. Keymap
	44	;; lookup proceeds down minor-mode-map-alist, and the order there
	45	;; tends to be the reverse of the order in which the modes were
	46	;; installed. Perhaps there should be a feature to let you specify
	47	;; orderings.
	48
5a7a545c SM	49	;; Additionally to `define-minor-mode', the package provides convenient
5a7a545c SM	50	;; ways to define keymaps, and other helper functions for major and minor modes.
6b279740	51
5a7a545c	52	;;; Code:
6b279740	53
29cc3b84	54	(defmacro easy-mmode-define-toggle (mode &optional doc &rest body)
6b279740	55	"Define a one arg toggle mode MODE function and associated hooks.
29cc3b84	56	MODE is the so defined function that toggles the mode.
6b279740	57	optional DOC is its associated documentation.
29cc3b84	58	BODY is executed after the toggling and before running the hooks.
6b279740 RS	59
	60	Hooks are checked for run, each time MODE-mode is called.
	61	They run under the followings conditions:
	62	MODE-hook: if the mode is toggled.
	63	MODE-on-hook: if the mode is on.
	64	MODE-off-hook: if the mode is off.
	65
	66	When the mode is effectively toggled, two hooks may run.
29cc3b84 SM	67	If so MODE-hook is guaranteed to be the first."
29cc3b84 SM	68	(let* ((mode-name (symbol-name mode))
6b279740 RS	69	(hook (intern (concat mode-name "-hook")))
	70	(hook-on (intern (concat mode-name "-on-hook")))
	71	(hook-off (intern (concat mode-name "-off-hook")))
6b279740	72	(toggle-doc (or doc
29cc3b84 SM	73	(format "With no argument, toggle %s.
	74	With universal prefix ARG turn mode on.
	75	With zero or negative ARG turn mode off.
	76	\\{%s}" mode-name (concat mode-name "-map")))))
6b279740	77	`(progn
29cc3b84 SM	78	(defcustom ,hook nil
	79	,(format "Hook called when `%s' is toggled" mode-name)
	80	:type 'hook)
6b279740	81
29cc3b84 SM	82	(defcustom ,hook-on nil
	83	,(format "Hook called when `%s' is turned on" mode-name)
	84	:type 'hook)
6b279740	85
29cc3b84 SM	86	(defcustom ,hook-off nil
	87	,(format "Hook called when `%s' is turned off" mode-name)
	88	:type 'hook)
6b279740	89
29cc3b84	90	(defun ,mode (&optional arg)
6b279740 RS	91	,toggle-doc
	92	(interactive "P")
	93	(let ((old-mode ,mode))
	94	(setq ,mode
	95	(if arg
29cc3b84	96	(> (prefix-numeric-value arg) 0)
6b279740	97	(not ,mode)))
29cc3b84 SM	98	,@body
	99	(unless (equal old-mode ,mode) (run-hooks ',hook))
	100	(run-hooks (if ,mode ',hook-on ',hook-off)))))))
6b279740 RS	101
6b279740 RS	102	;;;###autoload
29cc3b84 SM	103	(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
	104	;;;###autoload
	105	(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
6b279740 RS	106	"Define a new minor mode MODE.
	107	This function defines the associated control variable, keymap,
	108	toggle command, and hooks (see `easy-mmode-define-toggle').
	109
	110	DOC is the documentation for the mode toggle command.
29cc3b84	111	Optional INIT-VALUE is the initial value of the mode's variable.
6b279740 RS	112	Optional LIGHTER is displayed in the mode-bar when the mode is on.
	113	Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
	114	If it is a list, it is passed to `easy-mmode-define-keymap'
	115	in order to build a valid keymap.
29cc3b84 SM	116	BODY contains code that will be executed each time the mode is (dis)activated.
29cc3b84 SM	117	It will be executed after any toggling but before running the hooks."
6b279740	118	(let* ((mode-name (symbol-name mode))
29cc3b84 SM	119	(mode-doc (format "Non-nil if mode is enabled.
	120	Use the function `%s' to change this variable." mode-name))
	121	(keymap-sym (intern (concat mode-name "-map")))
	122	(keymap-doc (format "Keymap for `%s'." mode-name)))
6b279740	123	`(progn
5e21ef7a	124	;; Define the variable to enable or disable the mode.
6b279740 RS	125	(defvar ,mode ,init-value ,mode-doc)
	126	(make-variable-buffer-local ',mode)
	127
5e21ef7a	128	;; Define the minor-mode keymap.
29cc3b84 SM	129	,(when keymap
	130	`(defvar ,keymap-sym
	131	(cond ((and ,keymap (keymapp ,keymap))
	132	,keymap)
	133	((listp ,keymap)
	134	(easy-mmode-define-keymap ,keymap))
	135	(t (error "Invalid keymap %S" ,keymap)))
	136	,keymap-doc))
6b279740	137
5e21ef7a	138	;; Define the toggle and the hooks.
29cc3b84	139	(easy-mmode-define-toggle ,mode ,doc ,@body)
6b279740	140
5e21ef7a	141	;; Update the mode line.
6b279740 RS	142	(or (assq ',mode minor-mode-alist)
6b279740 RS	143	(setq minor-mode-alist
5e21ef7a KH	144	(cons (list ',mode nil) minor-mode-alist)))
5e21ef7a KH	145	(setcar (cdr (assq ',mode minor-mode-alist)) ,lighter)
6b279740	146
5e21ef7a	147	;; Update the minor mode map.
6b279740	148	(or (assq ',mode minor-mode-map-alist)
29cc3b84 SM	149	(setq minor-mode-map-alist
29cc3b84 SM	150	(cons (cons ',mode nil) minor-mode-map-alist)))
5e21ef7a	151	(setcdr (assq ',mode minor-mode-map-alist)
29cc3b84	152	,keymap-sym)) ))
6b279740	153
5a7a545c SM	154	\f
	155	;;;
	156	;;; easy-mmode-defmap
	157	;;;
	158
	159	(if (fboundp 'set-keymap-parents)
	160	(defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
	161	(defun easy-mmode-set-keymap-parents (m parents)
	162	(set-keymap-parent
	163	m
	164	(cond
	165	((not (consp parents)) parents)
	166	((not (cdr parents)) (car parents))
	167	(t (let ((m (copy-keymap (pop parents))))
	168	(easy-mmode-set-keymap-parents m parents)
	169	m))))))
	170
	171	(defun easy-mmode-define-keymap (bs &optional name m args)
	172	"Return a keymap built from bindings BS.
	173	BS must be a list of (KEY . BINDING) where
	174	KEY and BINDINGS are suited as for define-key.
	175	optional NAME is passed to `make-sparse-keymap'.
	176	optional map M can be used to modify an existing map.
	177	ARGS is a list of additional arguments."
	178	(let (inherit dense suppress)
	179	(while args
	180	(let ((key (pop args))
	181	(val (pop args)))
	182	(cond
	183	((eq key :dense) (setq dense val))
	184	((eq key :inherit) (setq inherit val))
	185	((eq key :group) )
	186	;;((eq key :suppress) (setq suppress val))
	187	(t (message "Unknown argument %s in defmap" key)))))
	188	(unless (keymapp m)
	189	(setq bs (append m bs))
	190	(setq m (if dense (make-keymap name) (make-sparse-keymap name))))
	191	(dolist (b bs)
	192	(let ((keys (car b))
	193	(binding (cdr b)))
	194	(dolist (key (if (consp keys) keys (list keys)))
	195	(cond
	196	((symbolp key)
	197	(substitute-key-definition key binding m global-map))
	198	((null binding)
	199	(unless (keymapp (lookup-key m key)) (define-key m key binding)))
	200	((let ((o (lookup-key m key)))
	201	(or (null o) (numberp o) (eq o 'undefined)))
	202	(define-key m key binding))))))
	203	(cond
	204	((keymapp inherit) (set-keymap-parent m inherit))
	205	((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
	206	m))
	207
	208	;;;###autoload
	209	(defmacro easy-mmode-defmap (m bs doc &rest args)
e4ad5f9e SM	210	`(progn
	211	(autoload 'easy-mmode-define-keymap "easy-mmode")
	212	(defconst ,m
	213	(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
	214	,doc)))
5a7a545c SM	215
	216	\f
	217	;;;
	218	;;; easy-mmode-defsyntax
	219	;;;
	220
	221	(defun easy-mmode-define-syntax (css args)
	222	(let ((st (make-syntax-table (cadr (memq :copy args)))))
	223	(dolist (cs css)
	224	(let ((char (car cs))
	225	(syntax (cdr cs)))
	226	(if (sequencep char)
e4ad5f9e	227	(mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
5a7a545c SM	228	(modify-syntax-entry char syntax st))))
	229	st))
	230
	231	;;;###autoload
	232	(defmacro easy-mmode-defsyntax (st css doc &rest args)
e4ad5f9e SM	233	`(progn
	234	(autoload 'easy-mmode-define-syntax "easy-mmode")
	235	(defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) doc)))
5a7a545c SM	236
	237
	238	\f
	239	;;; A "macro-only" reimplementation of define-derived-mode.
	240
	241	(defmacro easy-mmode-define-derived-mode (child parent name &optional docstring &rest body)
	242	"Create a new mode as a variant of an existing mode.
	243
	244	The arguments to this command are as follow:
	245
	246	CHILD: the name of the command for the derived mode.
	247	PARENT: the name of the command for the parent mode (e.g. `text-mode').
	248	NAME: a string which will appear in the status line (e.g. \"Hypertext\")
	249	DOCSTRING: an optional documentation string--if you do not supply one,
	250	the function will attempt to invent something useful.
	251	BODY: forms to execute just before running the
	252	hooks for the new mode.
	253
	254	Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
	255
	256	(define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
	257
	258	You could then make new key bindings for `LaTeX-thesis-mode-map'
	259	without changing regular LaTeX mode. In this example, BODY is empty,
	260	and DOCSTRING is generated by default.
	261
	262	On a more complicated level, the following command uses `sgml-mode' as
	263	the parent, and then sets the variable `case-fold-search' to nil:
	264
	265	(define-derived-mode article-mode sgml-mode \"Article\"
	266	\"Major mode for editing technical articles.\"
	267	(setq case-fold-search nil))
	268
	269	Note that if the documentation string had been left out, it would have
	270	been generated automatically, with a reference to the keymap."
	271
5a7a545c SM	272	(let* ((child-name (symbol-name child))
	273	(map (intern (concat child-name "-map")))
	274	(syntax (intern (concat child-name "-syntax-table")))
	275	(abbrev (intern (concat child-name "-abbrev-table")))
	276	(hook (intern (concat child-name "-hook"))))
	277
e4ad5f9e SM	278	(when (and docstring (not (stringp docstring)))
	279	;; DOCSTRING is really the first command and there's no docstring
	280	(push docstring body)
	281	(setq docstring nil))
	282
	283	(unless (stringp docstring)
	284	;; Use a default docstring.
	285	(setq docstring
5a7a545c SM	286	(format "Major mode derived from `%s' by `define-derived-mode'.
	287	Inherits all of the parent's attributes, but has its own keymap,
	288	abbrev table and syntax table:
	289
	290	`%s', `%s' and `%s'
	291
e4ad5f9e SM	292	which more-or-less shadow %s's corresponding tables."
	293	parent map syntax abbrev parent)))
	294
	295	(unless (string-match (regexp-quote (symbol-name hook)) docstring)
	296	;; Make sure the docstring mentions the mode's hook
	297	(setq docstring (format "%s
	298	This mode runs (additionally to any hooks his parent might have run)
	299	its own `%s' just before exiting."
	300	docstring hook)))
5a7a545c	301
e4ad5f9e SM	302	(unless (string-match "\\\\[{[]" docstring)
	303	;; And don't forget to put the mode's keymap
	304	(setq docstring (concat docstring "\n\\{" (symbol-name map) "}")))
	305
	306	`(progn
	307	(defvar ,map (make-sparse-keymap))
	308	(defvar ,syntax (make-char-table 'syntax-table nil))
	309	(defvar ,abbrev (progn (define-abbrev-table ',abbrev nil) ,abbrev))
	310
	311	(defun ,child ()
	312	,docstring
	313	(interactive)
5a7a545c	314	; Run the parent.
e4ad5f9e	315	(,parent)
5a7a545c	316	; Identify special modes.
e4ad5f9e	317	(put ',child 'special (get ',parent 'special))
5a7a545c	318	; Identify the child mode.
e4ad5f9e SM	319	(setq major-mode ',child)
e4ad5f9e SM	320	(setq mode-name ,name)
5a7a545c	321	; Set up maps and tables.
e4ad5f9e SM	322	(unless (keymap-parent ,map)
	323	(set-keymap-parent ,map (current-local-map)))
	324	(let ((parent (char-table-parent ,syntax)))
	325	(unless (and parent (not (eq parent (standard-syntax-table))))
	326	(set-char-table-parent ,syntax (syntax-table))))
	327	(when local-abbrev-table
	328	(mapatoms
	329	(lambda (symbol)
	330	(or (intern-soft (symbol-name symbol) ,abbrev)
	331	(define-abbrev ,abbrev (symbol-name symbol)
	332	(symbol-value symbol) (symbol-function symbol))))
	333	local-abbrev-table))
5a7a545c	334
e4ad5f9e SM	335	(use-local-map ,map)
	336	(set-syntax-table ,syntax)
	337	(setq local-abbrev-table ,abbrev)
5a7a545c	338	; Splice in the body (if any).
e4ad5f9e	339	,@body
5a7a545c	340	; Run the hooks, if any.
e4ad5f9e SM	341	(run-hooks ',hook)))))
e4ad5f9e SM	342
5a7a545c	343
6b279740 RS	344	(provide 'easy-mmode)
	345
	346	;;; easy-mmode.el ends here