;;
;; (define-derived-mode html-mode hypertext-mode "HTML")
;; [various key definitions]
-;;
+;;
;; will add a new major mode for HTML with very little fuss.
;;
;; Note also the function `derived-mode-p' which can tell if the current
\f
;;; Code:
+;;; PRIVATE: defsubst must be defined before they are first used
+
+(defsubst derived-mode-hook-name (mode)
+ "Construct the mode hook name based on mode name MODE."
+ (intern (concat (symbol-name mode) "-hook")))
+
+(defsubst derived-mode-map-name (mode)
+ "Construct a map name based on a MODE name."
+ (intern (concat (symbol-name mode) "-map")))
+
+(defsubst derived-mode-syntax-table-name (mode)
+ "Construct a syntax-table name based on a MODE name."
+ (intern (concat (symbol-name mode) "-syntax-table")))
+
+(defsubst derived-mode-abbrev-table-name (mode)
+ "Construct an abbrev-table name based on a MODE name."
+ (intern (concat (symbol-name mode) "-abbrev-table")))
+
;; PUBLIC: define a new major mode which inherits from an existing one.
;;;###autoload
DOCSTRING: an optional documentation string--if you do not supply one,
the function will attempt to invent something useful.
BODY: forms to execute just before running the
- hooks for the new mode.
+ hooks for the new mode. Do not use `interactive' here.
Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
(abbrev (derived-mode-abbrev-table-name child))
(hook (derived-mode-hook-name child))
(docstring (derived-mode-make-docstring parent child docstring)))
-
+
`(progn
(defvar ,map (make-sparse-keymap))
(defvar ,syntax (make-syntax-table))
- (defvar ,abbrev)
- (define-abbrev-table ',abbrev nil)
+ (defvar ,abbrev
+ (progn (define-abbrev-table ',abbrev nil) ,abbrev))
(put ',child 'derived-mode-parent ',parent)
-
+
(defun ,child ()
,docstring
(interactive)
; Run the parent.
- ;; (combine-run-hooks
+ (delay-mode-hooks
(,(or parent 'kill-all-local-variables))
; Identify the child mode.
; Identify special modes.
,(when parent
`(progn
- (if (get (quote ,parent) 'special)
- (put (quote ,child) 'special t))
+ (if (get (quote ,parent) 'mode-class)
+ (put (quote ,child) 'mode-class
+ (get (quote ,parent) 'mode-class)))
; Set up maps and tables.
(unless (keymap-parent ,map)
(set-keymap-parent ,map (current-local-map)))
(define-abbrev ,abbrev (symbol-name symbol)
(symbol-value symbol) (symbol-function symbol))))
local-abbrev-table))))
-
+
(use-local-map ,map)
(set-syntax-table ,syntax)
(setq local-abbrev-table ,abbrev)
; Splice in the body (if any).
,@body
- ;; )
+ )
; Run the hooks, if any.
- (run-hooks ',hook)))))
-
-;; PUBLIC: find if the current mode derives from another.
-
-(defun derived-mode-p (&rest modes)
- "Non-nil if the current major mode is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards."
- (let ((parent major-mode))
- (while (and (not (memq parent modes))
- (setq parent (get parent 'derived-mode-parent))))
- parent))
+ (run-mode-hooks ',hook)))))
;; PUBLIC: find the ultimate class of a derived mode.
"Find the class of a major MODE.
A mode's class is the first ancestor which is NOT a derived mode.
Use the `derived-mode-parent' property of the symbol to trace backwards.
-Since major-modes might derive from each other and from `fundamental-mode',
-this function is not very useful. Use `derived-mode-p' instead."
+Since major-modes might all derive from `fundamental-mode', this function
+is not very useful."
(while (get mode 'derived-mode-parent)
(setq mode (get mode 'derived-mode-parent)))
mode)
+(make-obsolete 'derived-mode-class 'derived-mode-p "21.4")
\f
;;; PRIVATE
-(defsubst derived-mode-hook-name (mode)
- "Construct the mode hook name based on mode name MODE."
- (intern (concat (symbol-name mode) "-hook")))
-
-(defsubst derived-mode-map-name (mode)
- "Construct a map name based on a MODE name."
- (intern (concat (symbol-name mode) "-map")))
-
-(defsubst derived-mode-syntax-table-name (mode)
- "Construct a syntax-table name based on a MODE name."
- (intern (concat (symbol-name mode) "-syntax-table")))
-
-(defsubst derived-mode-abbrev-table-name (mode)
- "Construct an abbrev-table name based on a MODE name."
- (intern (concat (symbol-name mode) "-abbrev-table")))
-
(defun derived-mode-make-docstring (parent child &optional docstring)
"Construct a docstring for a new mode if none is provided."
which more-or-less shadow %s's corresponding tables."
parent map abbrev syntax parent))))
-
+
(unless (string-match (regexp-quote (symbol-name hook)) docstring)
;; Make sure the docstring mentions the mode's hook
(setq docstring
"might have run,\nthis mode "))
(format "runs the hook `%s'" hook)
", as the final step\nduring initialization.")))
-
+
(unless (string-match "\\\\[{[]" docstring)
;; And don't forget to put the mode's keymap
(setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
(define-abbrev new (symbol-name symbol)
(symbol-value symbol) (symbol-function symbol))))
old)))
-
+
(provide 'derived)
;;; derived.el ends here