Mercurial > emacs
comparison lisp/derived.el @ 5765:021bdb142040
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 04 Feb 1994 00:30:33 +0000 |
parents | |
children | 27a2ad893b22 |
comparison
equal
deleted
inserted
replaced
5764:5726c18895e3 | 5765:021bdb142040 |
---|---|
1 ;;; mode-clone.el (alpha version) -- allow inheritance of major modes. | |
2 ;;; $Id: mode-clone.el,v 1.5 1993/12/25 14:02:33 david Exp $ | |
3 | |
4 ;; Copyright (C) 1993 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: David Megginson (dmeggins@aix1.uottawa.ca) | |
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 | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
24 ;;; Commentary: | |
25 | |
26 ;; GNU Emacs is already, in a sense, object oriented -- each object | |
27 ;; (buffer) belongs to a class (major mode), and that class defines | |
28 ;; the relationship between messages (input events) and methods | |
29 ;; (commands) by means of a keymap. | |
30 ;; | |
31 ;; The only thing missing is a good scheme of inheritance. It is | |
32 ;; possible to simulate a single level of inheritance with generous | |
33 ;; use of hooks and a bit of work -- sgml-mode, for example, also runs | |
34 ;; the hooks for text-mode, and keymaps can inherit from other keymaps | |
35 ;; -- but generally, each major mode ends up reinventing the wheel. | |
36 ;; Ideally, someone should redesign all of Emacs's major modes to | |
37 ;; follow a more conventional object-oriented system: when defining a | |
38 ;; new major mode, the user should need only to name the existing mode | |
39 ;; it is most similar to, then list the (few) differences. | |
40 ;; | |
41 ;; In the mean time, this package offers most of the advantages of | |
42 ;; full inheritance with the existing major modes. The function | |
43 ;; `mode-clone' allows the user to make a clone of an existing | |
44 ;; 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 ;; every time it is called. For example, the commands | |
47 ;; | |
48 ;; (mode-clone text-mode hypertext-mode "Hypertext" | |
49 ;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}" | |
50 ;; (setq case-fold-search nil)) | |
51 ;; | |
52 ;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link) | |
53 ;; | |
54 ;; will create a function `hypertext-mode' with its own (sparse) | |
55 ;; keymap `hypertext-mode-map.' The command M-x hypertext-mode will | |
56 ;; perform the following actions: | |
57 ;; | |
58 ;; - run the command (text-mode) to get its default setup | |
59 ;; - replace the current keymap with 'hypertext-mode-map,' which will | |
60 ;; inherit from 'text-mode-map'. | |
61 ;; - replace the current syntax table with | |
62 ;; 'hypertext-mode-syntax-table', which will borrow its defaults | |
63 ;; from the current text-mode-syntax-table. | |
64 ;; - if 'hypertext-mode-abbrev-table' exists, it will become the | |
65 ;; current abbrev table. | |
66 ;; - change the mode line to read "Hypertext" | |
67 ;; - assign the value 'hypertext-mode' to the 'major-mode' variable | |
68 ;; - run the body of commands provided in the macro -- in this case, | |
69 ;; set the local variable `case-fold-search' to nil. | |
70 ;; - **run the command (hypertext-mode-setup), which is empty by | |
71 ;; default, but may be redefined by the user to contain special | |
72 ;; commands (ie. setting local variables like 'outline-regexp') | |
73 ;; **NOTE: do not use this option -- it will soon be obsolete. | |
74 ;; - run anything assigned to 'hypertext-mode-hooks' (obsolete, but | |
75 ;; supported for the sake of compatibility). | |
76 ;; | |
77 ;; The advantages of this system are threefold. First, text mode is | |
78 ;; untouched -- if you had added the new keystroke to `text-mode-map,' | |
79 ;; possibly using hooks, you would have added it to all text buffers | |
80 ;; -- here, it appears only in hypertext buffers, where it makes | |
81 ;; sense. Second, it is possible to build even further, and clone the | |
82 ;; clone. The commands | |
83 ;; | |
84 ;; (mode-clone hypertext-mode html-mode "HTML") | |
85 ;; [various key definitions] | |
86 ;; | |
87 ;; will add a new major mode for HTML with very little fuss. | |
88 ;; | |
89 ;; Note also the function `clone-class,' which returns the non-clone | |
90 ;; major mode which a clone is based on (ie. NOT necessarily the | |
91 ;; immediate parent). | |
92 ;; | |
93 ;; (clone-class 'text-mode) ==> text-mode | |
94 ;; (clone-class 'hypertext-mode) ==> text-mode | |
95 ;; (clone-class 'html-mode) ==> text-mode | |
96 | |
97 ;;; Code: | |
98 | |
99 ;; PUBLIC: define a new major mode which inherits from an existing one. | |
100 | |
101 ;;;###autoload | |
102 (defmacro mode-clone (parent child name &optional docstring &rest body) | |
103 "Create a new mode which is similar to an old one. | |
104 | |
105 The arguments to this command are as follow: | |
106 | |
107 parent: the name of the command for the parent mode (ie. text-mode) | |
108 child: the name of the command for the clone | |
109 name: a string which will appear in the status line (ie. \"Hypertext\") | |
110 docstring: an optional documentation string -- if you do not supply one, | |
111 the function will attempt to invent something useful. If this | |
112 argument is not a string, it will be added to body automatically. | |
113 body: a body of commands to execute just before running the | |
114 hooks for the new mode. | |
115 | |
116 The following simple command would clone LaTeX-mode into | |
117 LaTeX-thesis-mode: | |
118 | |
119 (mode-clone LaTeX-mode LaTeX-thesis-mode \"LaTeX-Thesis\") | |
120 | |
121 It would then be possible to assign commands to keystrokes in | |
122 `LaTeX-thesis-mode-map' without changing the interface in the regular | |
123 LaTeX-mode. The function (LaTeX-thesis-mode-setup), if it exists, | |
124 will contain commands which will run whenever (LaTeX-thesis-mode) is | |
125 run (just before 'LaTeX-thesis-mode-hooks). | |
126 | |
127 On a more complicated level, the following command would clone | |
128 sgml-mode and change the variable `case-fold-search' to nil: | |
129 | |
130 (mode-clone sgml-mode article-mode \"Article\" | |
131 \"Major mode for editing technical articles.\" | |
132 (setq case-fold-search nil)) | |
133 | |
134 Note that if the documentation string had been left out, it would have | |
135 been generated automatically, with a reference to the keymap." | |
136 | |
137 ; Some trickiness, since what | |
138 ; appears to be the docstring | |
139 ; may really be the first | |
140 ; element of the body. | |
141 (if (and docstring (not (stringp docstring))) | |
142 (progn (setq body (cons docstring body)) | |
143 (setq docstring nil))) | |
144 (setq docstring (or docstring (clone-make-docstring parent child))) | |
145 | |
146 (` (progn | |
147 (clone-init-mode-variables (quote (, child))) | |
148 (defun (, child) () | |
149 (, docstring) | |
150 (interactive) | |
151 ; Run the parent. | |
152 ((, parent)) | |
153 ; Identify special modes. | |
154 (if (get (quote (, parent)) 'special) | |
155 (put (quote (, child)) 'special t)) | |
156 ; Identify the child mode. | |
157 (setq major-mode (quote (, child))) | |
158 (setq mode-name (, name)) | |
159 ; Set up maps and tables. | |
160 (clone-set-keymap (quote (, child))) | |
161 (clone-set-syntax-table (quote (, child))) | |
162 (clone-set-abbrev-table (quote (, child))) | |
163 ; Splice in the body (if any). | |
164 (,@ body) | |
165 ; Run the setup function, if | |
166 ; any -- this will soon be | |
167 ; obsolete. | |
168 (clone-run-setup-function (quote (, child))) | |
169 ; Run the hooks, if any. | |
170 (clone-run-hooks (quote (, child))))))) | |
171 | |
172 | |
173 ;; PUBLIC: find the ultimate class of a clone mode. | |
174 | |
175 (defun clone-class (mode) | |
176 "Find the class of a major mode. | |
177 A mode's class is the first ancestor which is NOT a clone. | |
178 Use the `clone-parent' property of the symbol to trace backwards." | |
179 (while (get mode 'clone-parent) | |
180 (setq mode (get mode 'clone-parent))) | |
181 mode) | |
182 | |
183 | |
184 ;; Inline functions to construct various names from a mode name. | |
185 | |
186 (defsubst clone-setup-function-name (mode) | |
187 "Construct a setup-function name based on a mode name." | |
188 (intern (concat (symbol-name mode) "-setup"))) | |
189 | |
190 (defsubst clone-hooks-name (mode) | |
191 "Construct a hooks name based on a mode name." | |
192 (intern (concat (symbol-name mode) "-hooks"))) | |
193 | |
194 (defsubst clone-map-name (mode) | |
195 "Construct a map name based on a mode name." | |
196 (intern (concat (symbol-name mode) "-map"))) | |
197 | |
198 (defsubst clone-syntax-table-name (mode) | |
199 "Construct a syntax-table name based on a mode name." | |
200 (intern (concat (symbol-name mode) "-syntax-table"))) | |
201 | |
202 (defsubst clone-abbrev-table-name (mode) | |
203 "Construct an abbrev-table name based on a mode name." | |
204 (intern (concat (symbol-name mode) "-abbrev-table"))) | |
205 | |
206 | |
207 ;; Utility functions for defining a clone mode. | |
208 | |
209 (defun clone-init-mode-variables (mode) | |
210 "Initialise variables for a new mode. | |
211 Right now, just set up a blank keymap and an empty syntax table." | |
212 | |
213 (eval (` (defvar (, (clone-map-name mode)) | |
214 (make-sparse-keymap) | |
215 (, (format "Keymap for %s." mode))))) | |
216 (put (clone-map-name mode) 'clone-merged nil) | |
217 | |
218 (eval (` (defvar (, (clone-syntax-table-name mode)) | |
219 (make-vector 256 nil) | |
220 (, (format "Syntax table for %s." mode))))) | |
221 (put (clone-syntax-table-name mode) 'clone-merged nil) | |
222 | |
223 (eval (` (defvar (, (clone-abbrev-table-name mode)) | |
224 nil | |
225 (, (format "Abbrev table for %s." mode))))) | |
226 (define-abbrev-table (clone-abbrev-table-name mode) ())) | |
227 | |
228 (defun clone-make-docstring (parent child) | |
229 "Construct a docstring for a new mode if none is provided." | |
230 | |
231 (format "This major mode is a clone of (%s), created by (mode-clone). | |
232 It inherits all of the parent's attributes, but has its own keymap | |
233 and syntax table: | |
234 | |
235 '%s-map' and '%s-syntax-table' | |
236 | |
237 which more-or-less shadow | |
238 | |
239 '%s-map' and '%s-syntax-table' | |
240 | |
241 \\{%s-map}" parent child child parent parent child)) | |
242 | |
243 | |
244 ;; Utility functions for running a clone mode. | |
245 | |
246 (defun clone-set-keymap (mode) | |
247 "Set the keymap of the new mode, maybe merging with the parent." | |
248 (let* ((map-name (clone-map-name mode)) | |
249 (new-map (eval map-name)) | |
250 (old-map (current-local-map))) | |
251 (if (get map-name 'clone-merged) | |
252 (use-local-map new-map) | |
253 (put map-name 'clone-merged t) | |
254 (use-local-map (set map-name (clone-merge-keymaps old-map new-map)))))) | |
255 | |
256 (defun clone-set-syntax-table (mode) | |
257 "Set the syntax table of the new mode, maybe merging with the parent." | |
258 (let* ((table-name (clone-syntax-table-name mode)) | |
259 (old-table (syntax-table)) | |
260 (new-table (eval table-name))) | |
261 (if (get table-name 'clone-merged) | |
262 t | |
263 (clone-merge-syntax-tables old-table new-table)) | |
264 (set-syntax-table new-table) | |
265 (put table-name 'clone-merged t))) | |
266 | |
267 (defun clone-set-abbrev-table (mode) | |
268 "Set the abbrev table if it exists." | |
269 (let* ((table-name (clone-abbrev-table-name mode)) | |
270 (table (and (boundp table-name) (eval table-name)))) | |
271 (if table | |
272 (setq local-abbrev-table table)))) | |
273 | |
274 (defun clone-run-setup-function (mode) | |
275 "Run the setup function if it exists." | |
276 | |
277 (let ((fname (clone-setup-function-name mode))) | |
278 (if (fboundp fname) | |
279 (funcall fname)))) | |
280 | |
281 (defun clone-run-hooks (mode) | |
282 "Run the hooks if they exist." | |
283 | |
284 (let ((hooks-name (clone-hooks-name mode))) | |
285 (if (boundp hooks-name) | |
286 (run-hooks hooks-name)))) | |
287 | |
288 ;; Functions to merge maps and tables. | |
289 | |
290 (defun clone-merge-keymaps (old new) | |
291 "Merge a new keymap into an old one. | |
292 The old keymap is set to be the cdr of the new one, so that there will | |
293 be automatic inheritance." | |
294 (append new old)) | |
295 | |
296 (defun clone-merge-syntax-tables (old new) | |
297 "Merge a new syntax table into an old one. | |
298 Where the new table already has an entry, nothing is copied from the old one." | |
299 (let ((idx 0) | |
300 (end (min (length new) (length old)))) | |
301 (while (< idx end) | |
302 (if (not (aref new idx)) | |
303 (aset new idx (aref old idx))) | |
304 (setq idx (1+ idx))))) | |
305 | |
306 (provide 'mode-clone) | |
307 | |
308 ;;; mode-clone.el ends here |