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) |
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\") |
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 |
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 |
) |
) |
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) |
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) |
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)) |