diff options
| author | Richard M. Stallman | 1994-03-08 19:02:50 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-03-08 19:02:50 +0000 |
| commit | 06d35594f6a6285aff1026328d8006341458e82a (patch) | |
| tree | c769be1af48371e546a8453dbb50933615b19369 | |
| parent | 497513adfb749d50f50e84edd3228b015d85235c (diff) | |
| download | emacs-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.el | 150 |
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 | ||
| 106 | The arguments to this command are as follow: | 107 | The arguments to this command are as follow: |
| 107 | 108 | ||
| 108 | PARENT: the name of the command for the parent mode (ie. text-mode). | 109 | PARENT: the name of the command for the parent mode (ie. text-mode). |
| 109 | CHILD: the name of the command for the clone mode. | 110 | CHILD: the name of the command for the derived mode. |
| 110 | NAME: a string which will appear in the status line (ie. \"Hypertext\") | 111 | NAME: a string which will appear in the status line (ie. \"Hypertext\") |
| 111 | DOCSTRING: an optional documentation string--if you do not supply one, | 112 | DOCSTRING: 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. |
| 113 | BODY: forms to execute just before running the | 114 | BODY: forms to execute just before running the |
| 114 | hooks for the new mode. | 115 | hooks for the new mode. |
| 115 | 116 | ||
| 116 | The following simple command would clone LaTeX mode into | 117 | Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: |
| 117 | LaTeX-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 | ||
| 121 | You could then make new key bindings for `LaTeX-thesis-mode-map' | 121 | You could then make new key bindings for `LaTeX-thesis-mode-map' |
| 122 | without changing regular LaTeX mode. In this example, BODY is empty, | 122 | without changing regular LaTeX mode. In this example, BODY is empty, |
| 123 | and DOCSTRING is generated by default. | 123 | and DOCSTRING is generated by default. |
| 124 | 124 | ||
| 125 | On a more complicated level, the following command would clone | 125 | On a more complicated level, the following command uses sgml-mode as |
| 126 | sgml-mode and change the variable `case-fold-search' to nil: | 126 | the 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. |
| 175 | A mode's class is the first ancestor which is NOT a clone. | 175 | A mode's class is the first ancestor which is NOT a derived mode. |
| 176 | Use the `clone-parent' property of the symbol to trace backwards." | 176 | Use 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. |
| 209 | Right now, if they don't already exist, set up a blank keymap, an | 209 | Right now, if they don't already exist, set up a blank keymap, an |
| 210 | empty syntax table, and an empty abbrev table -- these will be merged | 210 | empty syntax table, and an empty abbrev table -- these will be merged |
| 211 | the first time the mode is used." | 211 | the 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'. |
| 238 | It inherits all of the parent's attributes, but has its own keymap, | 238 | It inherits all of the parent's attributes, but has its own keymap, |
| 239 | abbrev table and syntax table: | 239 | abbrev 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. |
| 274 | Always merge its parent into it, since the merge is non-destructive." | 274 | Always 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. |
| 299 | The old keymap is set to be the cdr of the new one, so that there will | 299 | The old keymap is set to be the cdr of the new one, so that there will |
| 300 | be automatic inheritance." | 300 | be 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. |
| 305 | Where the new table already has an entry, nothing is copied from the old one." | 305 | Where 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. |
| 315 | This function requires internal knowledge of how abbrev tables work, | 315 | This function requires internal knowledge of how abbrev tables work, |
| 316 | presuming that they are obarrays with the abbrev as the symbol, the expansion | 316 | presuming 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 | ||