;;
;; (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
The arguments to this command are as follow:
CHILD: the name of the command for the derived mode.
-PARENT: the name of the command for the parent mode (e.g. `text-mode').
+PARENT: the name of the command for the parent mode (e.g. `text-mode')
+ or nil if there is no parent.
NAME: a string which will appear in the status line (e.g. \"Hypertext\")
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:
(push docstring body)
(setq docstring nil))
- (unless parent (setq parent 'fundamental-mode))
+ (when (eq parent 'fundamental-mode) (setq parent nil))
(let ((map (derived-mode-map-name child))
(syntax (derived-mode-syntax-table-name child))
(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-char-table 'syntax-table nil))
- (defvar ,abbrev)
- (define-abbrev-table ',abbrev nil)
+ (defvar ,syntax (make-syntax-table))
+ (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
- (,parent)
- ; Identify special modes.
- (if (get (quote ,parent) 'special)
- (put (quote ,child) 'special t))
+ (,(or parent 'kill-all-local-variables))
; Identify the child mode.
(setq major-mode (quote ,child))
(setq mode-name ,name)
+ ; Identify special modes.
+ ,(when parent
+ `(progn
+ (if (get (quote ,parent) 'special)
+ (put (quote ,child) 'special t))
; Set up maps and tables.
- (unless (keymap-parent ,map)
- (set-keymap-parent ,map (current-local-map)))
- (let ((parent (char-table-parent ,syntax)))
- (unless (and parent (not (eq parent (standard-syntax-table))))
- (set-char-table-parent ,syntax (syntax-table))))
- (when local-abbrev-table
- (mapatoms
- (lambda (symbol)
- (or (intern-soft (symbol-name symbol) ,abbrev)
- (define-abbrev ,abbrev (symbol-name symbol)
- (symbol-value symbol) (symbol-function symbol))))
- local-abbrev-table))
-
+ (unless (keymap-parent ,map)
+ (set-keymap-parent ,map (current-local-map)))
+ (let ((parent (char-table-parent ,syntax)))
+ (unless (and parent (not (eq parent (standard-syntax-table))))
+ (set-char-table-parent ,syntax (syntax-table))))
+ (when local-abbrev-table
+ (mapatoms
+ (lambda (symbol)
+ (or (intern-soft (symbol-name symbol) ,abbrev)
+ (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.
\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."
(unless (stringp docstring)
;; Use a default docstring.
(setq docstring
- (format "Major mode derived from `%s' by `define-derived-mode'.
+ (if (null parent)
+ (format "Major-mode.
+Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
+ (format "Major mode derived from `%s' by `define-derived-mode'.
It inherits all of the parent's attributes, but has its own keymap,
abbrev table and syntax table:
`%s', `%s' and `%s'
which more-or-less shadow %s's corresponding tables."
- parent map abbrev syntax parent)))
-
+ 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
(concat docstring
- (if (eq parent 'fundamental-mode)
+ (if (null parent)
"\n\nThis mode "
(concat
"\n\nIn addition to any hooks its parent mode "
"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