/[emacs]/emacs/lisp/derived.el
ViewVC logotype

Diff of /emacs/lisp/derived.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20 by monnier, Fri May 26 00:42:30 2000 UTC revision 1.21 by monnier, Sun Dec 3 21:39:34 2000 UTC
# Line 5  Line 5 
5    
6  ;; Author: David Megginson (dmeggins@aix1.uottawa.ca)  ;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
7  ;; Maintainer: FSF  ;; Maintainer: FSF
8  ;; Keywords: obsolete  ;; Keywords: extensions
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
11    
# Line 26  Line 26 
26    
27  ;;; Commentary:  ;;; Commentary:
28    
 ;; Obsolete.  
 ;; Use the `derived-major-mode' provided by easy-mmode.el instead.  
 ;; It is only kept for backward compatibility with Emacs-20 byte-compiled  
 ;; files that refer to `derived-mode-init-mode-variables' and other functions.  
   
   
   
29  ;; GNU Emacs is already, in a sense, object oriented -- each object  ;; GNU Emacs is already, in a sense, object oriented -- each object
30  ;; (buffer) belongs to a class (major mode), and that class defines  ;; (buffer) belongs to a class (major mode), and that class defines
31  ;; the relationship between messages (input events) and methods  ;; the relationship between messages (input events) and methods
# Line 91  Line 84 
84  ;;  ;;
85  ;; will add a new major mode for HTML with very little fuss.  ;; will add a new major mode for HTML with very little fuss.
86  ;;  ;;
87  ;; Note also the function `derived-mode-class,' which returns the non-derived  ;; Note also the function `derived-mode-p' which can tell if the current
88  ;; major mode which a derived mode is based on (ie. NOT necessarily the  ;; mode derives from another.  In a hypertext-mode, buffer, for example,
89  ;; immediate parent).  ;; (derived-mode-p 'text-mode) would return non-nil.  This should always
90  ;;  ;; be used in place of (eq major-mode 'text-mode).
 ;; (derived-mode-class 'text-mode) ==> text-mode  
 ;; (derived-mode-class 'hypertext-mode) ==> text-mode  
 ;; (derived-mode-class 'html-mode) ==> text-mode  
91    
92  ;;; Code:  ;;; Code:
93    
94  ;; PUBLIC: define a new major mode which inherits from an existing one.  ;; PUBLIC: define a new major mode which inherits from an existing one.
95    
96  ;; ;;;###autoload  ;;;###autoload
 ;; Don't override the definition provided by easy-mmode.el  
 (unless (fboundp 'define-derived-mode)  
97  (defmacro define-derived-mode (child parent name &optional docstring &rest body)  (defmacro define-derived-mode (child parent name &optional docstring &rest body)
98    "Create a new mode as a variant of an existing mode.    "Create a new mode as a variant of an existing mode.
99    
# Line 137  the parent, and then sets the variable ` Line 125  the parent, and then sets the variable `
125  Note that if the documentation string had been left out, it would have  Note that if the documentation string had been left out, it would have
126  been generated automatically, with a reference to the keymap."  been generated automatically, with a reference to the keymap."
127    
128                                          ; Some trickiness, since what    (when (and docstring (not (stringp docstring)))
129                                          ; appears to be the docstring      ;; Some trickiness, since what appears to be the docstring may really be
130                                          ; may really be the first      ;; the first element of the body.
131                                          ; element of the body.      (push docstring body)
132    (if (and docstring (not (stringp docstring)))      (setq docstring nil))
133        (progn (setq body (cons docstring body))  
134               (setq docstring nil)))    (unless parent (setq parent 'fundamental-mode))
135    (setq docstring (or docstring (derived-mode-make-docstring parent child)))  
136      (let ((map (derived-mode-map-name child))
137    `(progn          (syntax (derived-mode-syntax-table-name child))
138       (derived-mode-init-mode-variables (quote ,child))          (abbrev (derived-mode-abbrev-table-name child))
139       (defun ,child ()          (hook (derived-mode-hook-name child))
140         ,docstring          (docstring (derived-mode-make-docstring parent child docstring)))
141         (interactive)          
142        `(progn
143           (defvar ,map (make-sparse-keymap))
144           (defvar ,syntax (make-char-table 'syntax-table nil))
145           (defvar ,abbrev)
146           (define-abbrev-table ',abbrev nil)
147           (put ',child 'derived-mode-parent ',parent)
148        
149           (defun ,child ()
150             ,docstring
151             (interactive)
152                                          ; Run the parent.                                          ; Run the parent.
153         (,parent)           (combine-run-hooks
154    
155              (,parent)
156                                          ; Identify special modes.                                          ; Identify special modes.
157         (if (get (quote ,parent) 'special)            (if (get (quote ,parent) 'special)
158             (put (quote ,child) 'special t))                (put (quote ,child) 'special t))
159                                          ; Identify the child mode.                                          ; Identify the child mode.
160         (setq major-mode (quote ,child))            (setq major-mode (quote ,child))
161         (setq mode-name ,name)            (setq mode-name ,name)
162                                          ; Set up maps and tables.                                          ; Set up maps and tables.
163         (derived-mode-set-keymap (quote ,child))            (unless (keymap-parent ,map)
164         (derived-mode-set-syntax-table (quote ,child))              (set-keymap-parent ,map (current-local-map)))
165         (derived-mode-set-abbrev-table (quote ,child))            (let ((parent (char-table-parent ,syntax)))
166                (unless (and parent (not (eq parent (standard-syntax-table))))
167                  (set-char-table-parent ,syntax (syntax-table))))
168              (when local-abbrev-table
169                (mapatoms
170                 (lambda (symbol)
171                   (or (intern-soft (symbol-name symbol) ,abbrev)
172                       (define-abbrev ,abbrev (symbol-name symbol)
173                         (symbol-value symbol) (symbol-function symbol))))
174                 local-abbrev-table))
175          
176              (use-local-map ,map)
177              (set-syntax-table ,syntax)
178              (setq local-abbrev-table ,abbrev)
179                                          ; Splice in the body (if any).                                          ; Splice in the body (if any).
180         ,@body            ,@body)
 ;;;                                     ; Run the setup function, if  
 ;;;                                     ; any -- this will soon be  
 ;;;                                     ; obsolete.  
 ;;;      (derived-mode-run-setup-function (quote ,child))  
181                                          ; Run the hooks, if any.                                          ; Run the hooks, if any.
182         (derived-mode-run-hooks (quote ,child))))))           (run-hooks ',hook)))))
183    
184    ;; PUBLIC: find if the current mode derives from another.
185    
186    (defun derived-mode-p (&rest modes)
187      "Non-nil if the current major mode is derived from one of MODES.
188    Uses the `derived-mode-parent' property of the symbol to trace backwards."
189      (let ((parent major-mode))
190        (while (and (not (memq parent modes))
191                    (setq parent (get parent 'derived-mode-parent))))
192        parent))
193    
194  ;; PUBLIC: find the ultimate class of a derived mode.  ;; PUBLIC: find the ultimate class of a derived mode.
195    
196  (defun derived-mode-class (mode)  (defun derived-mode-class (mode)
197    "Find the class of a major MODE.    "Find the class of a major MODE.
198  A mode's class is the first ancestor which is NOT a derived mode.  A mode's class is the first ancestor which is NOT a derived mode.
199  Use the `derived-mode-parent' property of the symbol to trace backwards."  Use the `derived-mode-parent' property of the symbol to trace backwards.
200    Since major-modes might derive from each other and from `fundamental-mode',
201    this function is not very useful.  Use `derived-mode-p' instead."
202    (while (get mode 'derived-mode-parent)    (while (get mode 'derived-mode-parent)
203      (setq mode (get mode 'derived-mode-parent)))      (setq mode (get mode 'derived-mode-parent)))
204    mode)    mode)
205    
206    
207  ;; Inline functions to construct various names from a mode name.  ;;; PRIVATE
   
 (defsubst derived-mode-setup-function-name (mode)  
   "Construct a setup-function name based on a MODE name."  
   (intern (concat (symbol-name mode) "-setup")))  
208    
209  (defsubst derived-mode-hook-name (mode)  (defsubst derived-mode-hook-name (mode)
210    "Construct the mode hook name based on mode name MODE."    "Construct the mode hook name based on mode name MODE."
# Line 206  Use the `derived-mode-parent' property o Line 222  Use the `derived-mode-parent' property o
222    "Construct an abbrev-table name based on a MODE name."    "Construct an abbrev-table name based on a MODE name."
223    (intern (concat (symbol-name mode) "-abbrev-table")))    (intern (concat (symbol-name mode) "-abbrev-table")))
224    
225    (defun derived-mode-make-docstring (parent child &optional docstring)
226      "Construct a docstring for a new mode if none is provided."
227    
228      (let ((map (derived-mode-map-name child))
229            (syntax (derived-mode-syntax-table-name child))
230            (abbrev (derived-mode-abbrev-table-name child))
231            (hook (derived-mode-hook-name child)))
232    
233        (unless (stringp docstring)
234          ;; Use a default docstring.
235          (setq docstring
236                (format "Major mode derived from `%s' by `define-derived-mode'.
237    It inherits all of the parent's attributes, but has its own keymap,
238    abbrev table and syntax table:
239    
240      `%s', `%s' and `%s'
241    
242    which more-or-less shadow %s's corresponding tables."
243                        parent map abbrev syntax parent)))
244      
245        (unless (string-match (regexp-quote (symbol-name hook)) docstring)
246          ;; Make sure the docstring mentions the mode's hook
247          (setq docstring
248                (concat docstring
249                        (if (eq parent 'fundamental-mode)
250                            "\n\nThis mode "
251                          (concat
252                           "\n\nIn addition to any hooks its parent mode "
253                           (if (string-match (regexp-quote (format "`%s'" parent))
254                                             docstring) nil
255                             (format "`%s' " parent))
256                           "might have run,\nthis mode "))
257                        (format "runs the hook `%s'" hook)
258                        ", as the final step\nduring initialization.")))
259        
260        (unless (string-match "\\\\[{[]" docstring)
261          ;; And don't forget to put the mode's keymap
262          (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
263    
264        docstring))
265    
266    
267    ;;; OBSOLETE
268    ;; The functions below are only provided for backward compatibility with
269    ;; code byte-compiled with versions of derived.el prior to Emacs-21.
270    
271    (defsubst derived-mode-setup-function-name (mode)
272      "Construct a setup-function name based on a MODE name."
273      (intern (concat (symbol-name mode) "-setup")))
274    
275    
276  ;; Utility functions for defining a derived mode.  ;; Utility functions for defining a derived mode.
277    
# Line 240  the first time the mode is used." Line 306  the first time the mode is used."
306                 (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)                 (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
307                 (make-abbrev-table))                 (make-abbrev-table))
308               ,(format "Abbrev table for %s." mode)))))               ,(format "Abbrev table for %s." mode)))))
   
 (defun derived-mode-make-docstring (parent child)  
   "Construct a docstring for a new mode if none is provided."  
   
   (format "This major mode is a variant of `%s', created by `define-derived-mode'.  
 It inherits all of the parent's attributes, but has its own keymap,  
 abbrev table and syntax table:  
   
   `%s-map' and `%s-syntax-table'  
   
 which more-or-less shadow  
   
   `%s-map' and `%s-syntax-table'  
   
 \\{%s-map}" parent child child parent parent child))  
   
309    
310  ;; Utility functions for running a derived mode.  ;; Utility functions for running a derived mode.
311    
# Line 298  Always merge its parent into it, since t Line 348  Always merge its parent into it, since t
348    
349  (defun derived-mode-run-hooks (mode)  (defun derived-mode-run-hooks (mode)
350    "Run the mode hook for MODE."    "Run the mode hook for MODE."
   
351    (let ((hooks-name (derived-mode-hook-name mode)))    (let ((hooks-name (derived-mode-hook-name mode)))
352      (if (boundp hooks-name)      (if (boundp hooks-name)
353          (run-hooks hooks-name))))          (run-hooks hooks-name))))

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26