/[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.30 by rms, Wed Dec 12 09:26:55 2001 UTC revision 1.30.4.1 by miles, Fri Apr 4 06:20:01 2003 UTC
# Line 91  Line 91 
91    
92  ;;; Code:  ;;; Code:
93    
94    (eval-when-compile (require 'cl))
95    
96  ;;; PRIVATE: defsubst must be defined before they are first used  ;;; PRIVATE: defsubst must be defined before they are first used
97    
98  (defsubst derived-mode-hook-name (mode)  (defsubst derived-mode-hook-name (mode)
# Line 126  DOCSTRING: an optional documentation str Line 128  DOCSTRING: an optional documentation str
128  BODY:      forms to execute just before running the  BODY:      forms to execute just before running the
129             hooks for the new mode.  Do not use `interactive' here.             hooks for the new mode.  Do not use `interactive' here.
130    
131    BODY can start with a bunch of keyword arguments.  The following keyword
132      arguments are currently understood:
133    :group GROUP
134            Declare the customization group that corresponds to this mode.
135    :syntax-table TABLE
136            Use TABLE instead of the default.
137            A nil value means to simply use the same syntax-table as the parent.
138    :abbrev-table TABLE
139            Use TABLE instead of the default.
140            A nil value means to simply use the same abbrev-table as the parent.
141    
142  Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:  Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
143    
144    (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")    (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
# Line 155  been generated automatically, with a ref Line 168  been generated automatically, with a ref
168    (let ((map (derived-mode-map-name child))    (let ((map (derived-mode-map-name child))
169          (syntax (derived-mode-syntax-table-name child))          (syntax (derived-mode-syntax-table-name child))
170          (abbrev (derived-mode-abbrev-table-name child))          (abbrev (derived-mode-abbrev-table-name child))
171            (declare-abbrev t)
172            (declare-syntax t)
173          (hook (derived-mode-hook-name child))          (hook (derived-mode-hook-name child))
174          (docstring (derived-mode-make-docstring parent child docstring)))          (group nil))
175    
176        ;; Process the keyword args.
177        (while (keywordp (car body))
178          (case (pop body)
179            (:group (setq group (pop body)))
180            (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
181            (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
182            (t (pop body))))
183    
184        (setq docstring (derived-mode-make-docstring
185                         parent child docstring syntax abbrev))
186    
187      `(progn      `(progn
188         (defvar ,map (make-sparse-keymap))         (defvar ,map (make-sparse-keymap))
189         (defvar ,syntax (make-syntax-table))         ,(if declare-syntax
190         (defvar ,abbrev              `(defvar ,syntax (make-syntax-table)))
191           (progn (define-abbrev-table ',abbrev nil) ,abbrev))         ,(if declare-abbrev
192                `(defvar ,abbrev
193                   (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
194         (put ',child 'derived-mode-parent ',parent)         (put ',child 'derived-mode-parent ',parent)
195           ,(if group `(put ',child 'custom-mode-group ,group))
196    
197         (defun ,child ()         (defun ,child ()
198           ,docstring           ,docstring
# Line 178  been generated automatically, with a ref Line 207  been generated automatically, with a ref
207                                          ; Identify special modes.                                          ; Identify special modes.
208            ,(when parent            ,(when parent
209               `(progn               `(progn
210                  (if (get (quote ,parent) 'special)                  (if (get (quote ,parent) 'mode-class)
211                      (put (quote ,child) 'special t))                      (put (quote ,child) 'mode-class
212                             (get (quote ,parent) 'mode-class)))
213                                          ; Set up maps and tables.                                          ; Set up maps and tables.
214                  (unless (keymap-parent ,map)                  (unless (keymap-parent ,map)
215                    (set-keymap-parent ,map (current-local-map)))                    (set-keymap-parent ,map (current-local-map)))
216                  (let ((parent (char-table-parent ,syntax)))                  ,(when declare-syntax
217                    (unless (and parent (not (eq parent (standard-syntax-table))))                     `(let ((parent (char-table-parent ,syntax)))
218                      (set-char-table-parent ,syntax (syntax-table))))                        (unless (and parent
219                  (when local-abbrev-table                                     (not (eq parent (standard-syntax-table))))
220                    (mapatoms                          (set-char-table-parent ,syntax (syntax-table)))))))
                    (lambda (symbol)  
                      (or (intern-soft (symbol-name symbol) ,abbrev)  
                          (define-abbrev ,abbrev (symbol-name symbol)  
                            (symbol-value symbol) (symbol-function symbol))))  
                    local-abbrev-table))))  
221    
222            (use-local-map ,map)            (use-local-map ,map)
223            (set-syntax-table ,syntax)            ,(when syntax `(set-syntax-table ,syntax))
224            (setq local-abbrev-table ,abbrev)            ,(when abbrev `(setq local-abbrev-table ,abbrev))
225                                          ; Splice in the body (if any).                                          ; Splice in the body (if any).
226            ,@body            ,@body
227            )            )
# Line 209  been generated automatically, with a ref Line 234  been generated automatically, with a ref
234    "Find the class of a major MODE.    "Find the class of a major MODE.
235  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.
236  Use the `derived-mode-parent' property of the symbol to trace backwards.  Use the `derived-mode-parent' property of the symbol to trace backwards.
237  Since major-modes might derive from each other and from `fundamental-mode',  Since major-modes might all derive from `fundamental-mode', this function
238  this function is not very useful.  Use `derived-mode-p' instead."  is not very useful."
239    (while (get mode 'derived-mode-parent)    (while (get mode 'derived-mode-parent)
240      (setq mode (get mode 'derived-mode-parent)))      (setq mode (get mode 'derived-mode-parent)))
241    mode)    mode)
242    (make-obsolete 'derived-mode-class 'derived-mode-p "21.4")
243    
244    
245  ;;; PRIVATE  ;;; PRIVATE
246    
247  (defun derived-mode-make-docstring (parent child &optional docstring)  (defun derived-mode-make-docstring (parent child &optional
248                                               docstring syntax abbrev)
249    "Construct a docstring for a new mode if none is provided."    "Construct a docstring for a new mode if none is provided."
250    
251    (let ((map (derived-mode-map-name child))    (let ((map (derived-mode-map-name child))
         (syntax (derived-mode-syntax-table-name child))  
         (abbrev (derived-mode-abbrev-table-name child))  
252          (hook (derived-mode-hook-name child)))          (hook (derived-mode-hook-name child)))
253    
254      (unless (stringp docstring)      (unless (stringp docstring)
# Line 242  which more-or-less shadow %s's correspon Line 267  which more-or-less shadow %s's correspon
267                        parent map abbrev syntax parent))))                        parent map abbrev syntax parent))))
268    
269      (unless (string-match (regexp-quote (symbol-name hook)) docstring)      (unless (string-match (regexp-quote (symbol-name hook)) docstring)
270        ;; Make sure the docstring mentions the mode's hook        ;; Make sure the docstring mentions the mode's hook.
271        (setq docstring        (setq docstring
272              (concat docstring              (concat docstring
273                      (if (null parent)                      (if (null parent)
# Line 257  which more-or-less shadow %s's correspon Line 282  which more-or-less shadow %s's correspon
282                      ", as the final step\nduring initialization.")))                      ", as the final step\nduring initialization.")))
283    
284      (unless (string-match "\\\\[{[]" docstring)      (unless (string-match "\\\\[{[]" docstring)
285        ;; And don't forget to put the mode's keymap        ;; And don't forget to put the mode's keymap.
286        (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))        (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
287    
288      docstring))      docstring))

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.30.4.1

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