aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-03-08 19:02:50 +0000
committerRichard M. Stallman1994-03-08 19:02:50 +0000
commit06d35594f6a6285aff1026328d8006341458e82a (patch)
treec769be1af48371e546a8453dbb50933615b19369
parent497513adfb749d50f50e84edd3228b015d85235c (diff)
downloademacs-06d35594f6a6285aff1026328d8006341458e82a.tar.gz
emacs-06d35594f6a6285aff1026328d8006341458e82a.zip
Renamed from mode-clone.el.
All functions renamed. (define-derived-mode): Renamed from define-mode-clone.
-rw-r--r--lisp/derived.el150
1 files changed, 74 insertions, 76 deletions
diff --git a/lisp/derived.el b/lisp/derived.el
index ead5ce532e4..db4c0ad5161 100644
--- a/lisp/derived.el
+++ b/lisp/derived.el
@@ -1,4 +1,5 @@
1;;; mode-clone.el -- allow inheritance of major modes. 1;;; derived.el -- allow inheritance of major modes.
2;;; (formerly mode-clone.el)
2 3
3;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 4;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4 5
@@ -40,12 +41,12 @@
40;; 41;;
41;; In the mean time, this package offers most of the advantages of 42;; In the mean time, this package offers most of the advantages of
42;; full inheritance with the existing major modes. The macro 43;; full inheritance with the existing major modes. The macro
43;; `define-mode-clone' allows the user to make a clone of an existing 44;; `define-derived-mode' allows the user to make a variant of an existing
44;; major mode, with its own keymap. The new mode will inherit the key 45;; major mode, with its own keymap. The new mode will inherit the key
45;; bindings of its parent, and will, in fact, run its parent first 46;; bindings of its parent, and will, in fact, run its parent first
46;; every time it is called. For example, the commands 47;; every time it is called. For example, the commands
47;; 48;;
48;; (define-mode-clone hypertext-mode text-mode "Hypertext" 49;; (define-derived-mode hypertext-mode text-mode "Hypertext"
49;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}" 50;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
50;; (setq case-fold-search nil)) 51;; (setq case-fold-search nil))
51;; 52;;
@@ -79,53 +80,52 @@
79;; untouched -- if you had added the new keystroke to `text-mode-map,' 80;; untouched -- if you had added the new keystroke to `text-mode-map,'
80;; possibly using hooks, you would have added it to all text buffers 81;; possibly using hooks, you would have added it to all text buffers
81;; -- here, it appears only in hypertext buffers, where it makes 82;; -- here, it appears only in hypertext buffers, where it makes
82;; sense. Second, it is possible to build even further, and clone the 83;; sense. Second, it is possible to build even further, and make
83;; clone. The commands 84;; a derived mode from a derived mode. The commands
84;; 85;;
85;; (define-mode-clone html-mode hypertext-mode "HTML") 86;; (define-derived-mode html-mode hypertext-mode "HTML")
86;; [various key definitions] 87;; [various key definitions]
87;; 88;;
88;; will add a new major mode for HTML with very little fuss. 89;; will add a new major mode for HTML with very little fuss.
89;; 90;;
90;; Note also the function `clone-class,' which returns the non-clone 91;; Note also the function `derived-mode-class,' which returns the non-derived
91;; major mode which a clone is based on (ie. NOT necessarily the 92;; major mode which a derived mode is based on (ie. NOT necessarily the
92;; immediate parent). 93;; immediate parent).
93;; 94;;
94;; (clone-class 'text-mode) ==> text-mode 95;; (derived-mode-class 'text-mode) ==> text-mode
95;; (clone-class 'hypertext-mode) ==> text-mode 96;; (derived-mode-class 'hypertext-mode) ==> text-mode
96;; (clone-class 'html-mode) ==> text-mode 97;; (derived-mode-class 'html-mode) ==> text-mode
97 98
98;;; Code: 99;;; Code:
99 100
100;; PUBLIC: define a new major mode which inherits from an existing one. 101;; PUBLIC: define a new major mode which inherits from an existing one.
101 102
102;;;###autoload 103;;;###autoload
103(defmacro define-mode-clone (child parent name &optional docstring &rest body) 104(defmacro define-derived-mode (child parent name &optional docstring &rest body)
104 "Create a new mode which is similar to an old one. 105 "Create a new mode as a variant of an existing mode.
105 106
106The arguments to this command are as follow: 107The arguments to this command are as follow:
107 108
108PARENT: the name of the command for the parent mode (ie. text-mode). 109PARENT: the name of the command for the parent mode (ie. text-mode).
109CHILD: the name of the command for the clone mode. 110CHILD: the name of the command for the derived mode.
110NAME: a string which will appear in the status line (ie. \"Hypertext\") 111NAME: a string which will appear in the status line (ie. \"Hypertext\")
111DOCSTRING: an optional documentation string--if you do not supply one, 112DOCSTRING: an optional documentation string--if you do not supply one,
112 the function will attempt to invent something useful. 113 the function will attempt to invent something useful.
113BODY: forms to execute just before running the 114BODY: forms to execute just before running the
114 hooks for the new mode. 115 hooks for the new mode.
115 116
116The following simple command would clone LaTeX mode into 117Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
117LaTeX-Thesis mode:
118 118
119 (define-mode-clone LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\") 119 (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
120 120
121You could then make new key bindings for `LaTeX-thesis-mode-map' 121You could then make new key bindings for `LaTeX-thesis-mode-map'
122without changing regular LaTeX mode. In this example, BODY is empty, 122without changing regular LaTeX mode. In this example, BODY is empty,
123and DOCSTRING is generated by default. 123and DOCSTRING is generated by default.
124 124
125On a more complicated level, the following command would clone 125On a more complicated level, the following command uses sgml-mode as
126sgml-mode and change the variable `case-fold-search' to nil: 126the parent, and then sets the variable `case-fold-search' to nil:
127 127
128 (define-mode-clone article-mode sgml-mode \"Article\" 128 (define-derived-mode article-mode sgml-mode \"Article\"
129 \"Major mode for editing technical articles.\" 129 \"Major mode for editing technical articles.\"
130 (setq case-fold-search nil)) 130 (setq case-fold-search nil))
131 131
@@ -139,10 +139,10 @@ been generated automatically, with a reference to the keymap."
139 (if (and docstring (not (stringp docstring))) 139 (if (and docstring (not (stringp docstring)))
140 (progn (setq body (cons docstring body)) 140 (progn (setq body (cons docstring body))
141 (setq docstring nil))) 141 (setq docstring nil)))
142 (setq docstring (or docstring (clone-make-docstring parent child))) 142 (setq docstring (or docstring (derived-mode-make-docstring parent child)))
143 143
144 (` (progn 144 (` (progn
145 (clone-init-mode-variables (quote (, child))) 145 (derived-mode-init-mode-variables (quote (, child)))
146 (defun (, child) () 146 (defun (, child) ()
147 (, docstring) 147 (, docstring)
148 (interactive) 148 (interactive)
@@ -155,86 +155,86 @@ been generated automatically, with a reference to the keymap."
155 (setq major-mode (quote (, child))) 155 (setq major-mode (quote (, child)))
156 (setq mode-name (, name)) 156 (setq mode-name (, name))
157 ; Set up maps and tables. 157 ; Set up maps and tables.
158 (clone-set-keymap (quote (, child))) 158 (derived-mode-set-keymap (quote (, child)))
159 (clone-set-syntax-table (quote (, child))) 159 (derived-mode-set-syntax-table (quote (, child)))
160 (clone-set-abbrev-table (quote (, child))) 160 (derived-mode-set-abbrev-table (quote (, child)))
161 ; Splice in the body (if any). 161 ; Splice in the body (if any).
162 (,@ body) 162 (,@ body)
163;;; ; Run the setup function, if 163;;; ; Run the setup function, if
164;;; ; any -- this will soon be 164;;; ; any -- this will soon be
165;;; ; obsolete. 165;;; ; obsolete.
166;;; (clone-run-setup-function (quote (, child))) 166;;; (derived-mode-run-setup-function (quote (, child)))
167 ; Run the hooks, if any. 167 ; Run the hooks, if any.
168 (clone-run-hooks (quote (, child))))))) 168 (derived-mode-run-hooks (quote (, child)))))))
169 169
170 170
171;; PUBLIC: find the ultimate class of a clone mode. 171;; PUBLIC: find the ultimate class of a derived mode.
172 172
173(defun clone-class (mode) 173(defun derived-mode-class (mode)
174 "Find the class of a major mode. 174 "Find the class of a major mode.
175A mode's class is the first ancestor which is NOT a clone. 175A mode's class is the first ancestor which is NOT a derived mode.
176Use the `clone-parent' property of the symbol to trace backwards." 176Use the `derived-mode-parent' property of the symbol to trace backwards."
177 (while (get mode 'clone-parent) 177 (while (get mode 'derived-mode-parent)
178 (setq mode (get mode 'clone-parent))) 178 (setq mode (get mode 'derived-mode-parent)))
179 mode) 179 mode)
180 180
181 181
182;; Inline functions to construct various names from a mode name. 182;; Inline functions to construct various names from a mode name.
183 183
184(defsubst clone-setup-function-name (mode) 184(defsubst derived-mode-setup-function-name (mode)
185 "Construct a setup-function name based on a mode name." 185 "Construct a setup-function name based on a mode name."
186 (intern (concat (symbol-name mode) "-setup"))) 186 (intern (concat (symbol-name mode) "-setup")))
187 187
188(defsubst clone-hooks-name (mode) 188(defsubst derived-mode-hooks-name (mode)
189 "Construct a hooks name based on a mode name." 189 "Construct a hooks name based on a mode name."
190 (intern (concat (symbol-name mode) "-hooks"))) 190 (intern (concat (symbol-name mode) "-hooks")))
191 191
192(defsubst clone-map-name (mode) 192(defsubst derived-mode-map-name (mode)
193 "Construct a map name based on a mode name." 193 "Construct a map name based on a mode name."
194 (intern (concat (symbol-name mode) "-map"))) 194 (intern (concat (symbol-name mode) "-map")))
195 195
196(defsubst clone-syntax-table-name (mode) 196(defsubst derived-mode-syntax-table-name (mode)
197 "Construct a syntax-table name based on a mode name." 197 "Construct a syntax-table name based on a mode name."
198 (intern (concat (symbol-name mode) "-syntax-table"))) 198 (intern (concat (symbol-name mode) "-syntax-table")))
199 199
200(defsubst clone-abbrev-table-name (mode) 200(defsubst derived-mode-abbrev-table-name (mode)
201 "Construct an abbrev-table name based on a mode name." 201 "Construct an abbrev-table name based on a mode name."
202 (intern (concat (symbol-name mode) "-abbrev-table"))) 202 (intern (concat (symbol-name mode) "-abbrev-table")))
203 203
204 204
205;; Utility functions for defining a clone mode. 205;; Utility functions for defining a derived mode.
206 206
207(defun clone-init-mode-variables (mode) 207(defun derived-mode-init-mode-variables (mode)
208 "Initialise variables for a new mode. 208 "Initialise variables for a new mode.
209Right now, if they don't already exist, set up a blank keymap, an 209Right now, if they don't already exist, set up a blank keymap, an
210empty syntax table, and an empty abbrev table -- these will be merged 210empty syntax table, and an empty abbrev table -- these will be merged
211the first time the mode is used." 211the first time the mode is used."
212 212
213 (if (boundp (clone-map-name mode)) 213 (if (boundp (derived-mode-map-name mode))
214 t 214 t
215 (eval (` (defvar (, (clone-map-name mode)) 215 (eval (` (defvar (, (derived-mode-map-name mode))
216 (make-sparse-keymap) 216 (make-sparse-keymap)
217 (, (format "Keymap for %s." mode))))) 217 (, (format "Keymap for %s." mode)))))
218 (put (clone-map-name mode) 'clone-unmerged t)) 218 (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
219 219
220 (if (boundp (clone-syntax-table-name mode)) 220 (if (boundp (derived-mode-syntax-table-name mode))
221 t 221 t
222 (eval (` (defvar (, (clone-syntax-table-name mode)) 222 (eval (` (defvar (, (derived-mode-syntax-table-name mode))
223 (make-vector 256 nil) 223 (make-vector 256 nil)
224 (, (format "Syntax table for %s." mode))))) 224 (, (format "Syntax table for %s." mode)))))
225 (put (clone-syntax-table-name mode) 'clone-unmerged t)) 225 (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
226 226
227 (if (boundp (clone-abbrev-table-name mode)) 227 (if (boundp (derived-mode-abbrev-table-name mode))
228 t 228 t
229 (eval (` (defvar (, (clone-abbrev-table-name mode)) 229 (eval (` (defvar (, (derived-mode-abbrev-table-name mode))
230 (progn (define-abbrev-table (clone-abbrev-table-name mode) nil) 230 (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
231 (make-abbrev-table)) 231 (make-abbrev-table))
232 (, (format "Abbrev table for %s." mode))))))) 232 (, (format "Abbrev table for %s." mode)))))))
233 233
234(defun clone-make-docstring (parent child) 234(defun derived-mode-make-docstring (parent child)
235 "Construct a docstring for a new mode if none is provided." 235 "Construct a docstring for a new mode if none is provided."
236 236
237 (format "This major mode is a clone of `%s', created by `define-mode-clone'. 237 (format "This major mode is a variant of `%s', created by `define-derived-mode'.
238It inherits all of the parent's attributes, but has its own keymap, 238It inherits all of the parent's attributes, but has its own keymap,
239abbrev table and syntax table: 239abbrev table and syntax table:
240 240
@@ -247,60 +247,60 @@ which more-or-less shadow
247\\{%s-map}" parent child child parent parent child)) 247\\{%s-map}" parent child child parent parent child))
248 248
249 249
250;; Utility functions for running a clone mode. 250;; Utility functions for running a derived mode.
251 251
252(defun clone-set-keymap (mode) 252(defun derived-mode-set-keymap (mode)
253 "Set the keymap of the new mode, maybe merging with the parent." 253 "Set the keymap of the new mode, maybe merging with the parent."
254 (let* ((map-name (clone-map-name mode)) 254 (let* ((map-name (derived-mode-map-name mode))
255 (new-map (eval map-name)) 255 (new-map (eval map-name))
256 (old-map (current-local-map))) 256 (old-map (current-local-map)))
257 (if (get map-name 'clone-unmerged) 257 (if (get map-name 'derived-mode-unmerged)
258 (clone-merge-keymaps old-map new-map)) 258 (derived-mode-merge-keymaps old-map new-map))
259 (put map-name 'clone-unmerged nil) 259 (put map-name 'derived-mode-unmerged nil)
260 (use-local-map new-map))) 260 (use-local-map new-map)))
261 261
262(defun clone-set-syntax-table (mode) 262(defun derived-mode-set-syntax-table (mode)
263 "Set the syntax table of the new mode, maybe merging with the parent." 263 "Set the syntax table of the new mode, maybe merging with the parent."
264 (let* ((table-name (clone-syntax-table-name mode)) 264 (let* ((table-name (derived-mode-syntax-table-name mode))
265 (old-table (syntax-table)) 265 (old-table (syntax-table))
266 (new-table (eval table-name))) 266 (new-table (eval table-name)))
267 (if (get table-name 'clone-unmerged) 267 (if (get table-name 'derived-mode-unmerged)
268 (clone-merge-syntax-tables old-table new-table)) 268 (derived-mode-merge-syntax-tables old-table new-table))
269 (put table-name 'clone-unmerged nil) 269 (put table-name 'derived-mode-unmerged nil)
270 (set-syntax-table new-table))) 270 (set-syntax-table new-table)))
271 271
272(defun clone-set-abbrev-table (mode) 272(defun derived-mode-set-abbrev-table (mode)
273 "Set the abbrev table if it exists. 273 "Set the abbrev table if it exists.
274Always merge its parent into it, since the merge is non-destructive." 274Always merge its parent into it, since the merge is non-destructive."
275 (let* ((table-name (clone-abbrev-table-name mode)) 275 (let* ((table-name (derived-mode-abbrev-table-name mode))
276 (old-table local-abbrev-table) 276 (old-table local-abbrev-table)
277 (new-table (eval table-name))) 277 (new-table (eval table-name)))
278 (clone-merge-abbrev-tables old-table new-table) 278 (derived-mode-merge-abbrev-tables old-table new-table)
279 (setq local-abbrev-table new-table))) 279 (setq local-abbrev-table new-table)))
280 280
281;;;(defun clone-run-setup-function (mode) 281;;;(defun derived-mode-run-setup-function (mode)
282;;; "Run the setup function if it exists." 282;;; "Run the setup function if it exists."
283 283
284;;; (let ((fname (clone-setup-function-name mode))) 284;;; (let ((fname (derived-mode-setup-function-name mode)))
285;;; (if (fboundp fname) 285;;; (if (fboundp fname)
286;;; (funcall fname)))) 286;;; (funcall fname))))
287 287
288(defun clone-run-hooks (mode) 288(defun derived-mode-run-hooks (mode)
289 "Run the hooks if they exist." 289 "Run the hooks if they exist."
290 290
291 (let ((hooks-name (clone-hooks-name mode))) 291 (let ((hooks-name (derived-mode-hooks-name mode)))
292 (if (boundp hooks-name) 292 (if (boundp hooks-name)
293 (run-hooks hooks-name)))) 293 (run-hooks hooks-name))))
294 294
295;; Functions to merge maps and tables. 295;; Functions to merge maps and tables.
296 296
297(defun clone-merge-keymaps (old new) 297(defun derived-mode-merge-keymaps (old new)
298 "Merge an old keymap into a new one. 298 "Merge an old keymap into a new one.
299The old keymap is set to be the cdr of the new one, so that there will 299The old keymap is set to be the cdr of the new one, so that there will
300be automatic inheritance." 300be automatic inheritance."
301 (setcdr (nthcdr (1- (length new)) new) old)) 301 (setcdr (nthcdr (1- (length new)) new) old))
302 302
303(defun clone-merge-syntax-tables (old new) 303(defun derived-mode-merge-syntax-tables (old new)
304 "Merge an old syntax table into a new one. 304 "Merge an old syntax table into a new one.
305Where the new table already has an entry, nothing is copied from the old one." 305Where the new table already has an entry, nothing is copied from the old one."
306 (let ((idx 0) 306 (let ((idx 0)
@@ -310,7 +310,7 @@ Where the new table already has an entry, nothing is copied from the old one."
310 (aset new idx (aref old idx))) 310 (aset new idx (aref old idx)))
311 (setq idx (1+ idx))))) 311 (setq idx (1+ idx)))))
312 312
313(defun clone-merge-abbrev-tables (old new) 313(defun derived-mode-merge-abbrev-tables (old new)
314 "Merge an old abbrev table into a new one. 314 "Merge an old abbrev table into a new one.
315This function requires internal knowledge of how abbrev tables work, 315This function requires internal knowledge of how abbrev tables work,
316presuming that they are obarrays with the abbrev as the symbol, the expansion 316presuming that they are obarrays with the abbrev as the symbol, the expansion
@@ -324,8 +324,6 @@ This could well break with some future version of Gnu Emacs."
324 (symbol-value symbol) (symbol-function symbol))))) 324 (symbol-value symbol) (symbol-function symbol)))))
325 old)) 325 old))
326 326
327(provide 'mode-clone) 327(provide 'derived)
328
329;;; mode-clone.el ends here
330
331 328
329;;; derived.el ends here