# HG changeset patch # User Stefan Monnier # Date 975879574 0 # Node ID 7f4f9332942e1f5373594aaa754547c7a1516f31 # Parent 7292ef94c1f5802abdf04ebcd6b4afdde3043136 (define-derived-mode): Revived, moved from easy-mmode.el. (derived-mode-p): New function. (derived-mode-make-docstring): Add `docstring' argument. Use it if available and complete it if necessary. diff -r 7292ef94c1f5 -r 7f4f9332942e lisp/derived.el --- a/lisp/derived.el Sun Dec 03 17:44:11 2000 +0000 +++ b/lisp/derived.el Sun Dec 03 21:39:34 2000 +0000 @@ -5,7 +5,7 @@ ;; Author: David Megginson (dmeggins@aix1.uottawa.ca) ;; Maintainer: FSF -;; Keywords: obsolete +;; Keywords: extensions ;; This file is part of GNU Emacs. @@ -26,13 +26,6 @@ ;;; Commentary: -;; 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. - - - ;; GNU Emacs is already, in a sense, object oriented -- each object ;; (buffer) belongs to a class (major mode), and that class defines ;; the relationship between messages (input events) and methods @@ -91,21 +84,16 @@ ;; ;; will add a new major mode for HTML with very little fuss. ;; -;; Note also the function `derived-mode-class,' which returns the non-derived -;; major mode which a derived mode is based on (ie. NOT necessarily the -;; immediate parent). -;; -;; (derived-mode-class 'text-mode) ==> text-mode -;; (derived-mode-class 'hypertext-mode) ==> text-mode -;; (derived-mode-class 'html-mode) ==> text-mode +;; Note also the function `derived-mode-p' which can tell if the current +;; mode derives from another. In a hypertext-mode, buffer, for example, +;; (derived-mode-p 'text-mode) would return non-nil. This should always +;; be used in place of (eq major-mode 'text-mode). ;;; Code: ;; PUBLIC: define a new major mode which inherits from an existing one. -;; ;;;###autoload -;; Don't override the definition provided by easy-mmode.el -(unless (fboundp 'define-derived-mode) +;;;###autoload (defmacro define-derived-mode (child parent name &optional docstring &rest body) "Create a new mode as a variant of an existing mode. @@ -137,58 +125,86 @@ Note that if the documentation string had been left out, it would have been generated automatically, with a reference to the keymap." - ; Some trickiness, since what - ; appears to be the docstring - ; may really be the first - ; element of the body. - (if (and docstring (not (stringp docstring))) - (progn (setq body (cons docstring body)) - (setq docstring nil))) - (setq docstring (or docstring (derived-mode-make-docstring parent child))) + (when (and docstring (not (stringp docstring))) + ;; Some trickiness, since what appears to be the docstring may really be + ;; the first element of the body. + (push docstring body) + (setq docstring nil)) + + (unless parent (setq parent 'fundamental-mode)) - `(progn - (derived-mode-init-mode-variables (quote ,child)) - (defun ,child () - ,docstring - (interactive) + (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) + (put ',child 'derived-mode-parent ',parent) + + (defun ,child () + ,docstring + (interactive) ; Run the parent. - (,parent) + (combine-run-hooks + + (,parent) ; Identify special modes. - (if (get (quote ,parent) 'special) - (put (quote ,child) 'special t)) + (if (get (quote ,parent) 'special) + (put (quote ,child) 'special t)) ; Identify the child mode. - (setq major-mode (quote ,child)) - (setq mode-name ,name) + (setq major-mode (quote ,child)) + (setq mode-name ,name) ; Set up maps and tables. - (derived-mode-set-keymap (quote ,child)) - (derived-mode-set-syntax-table (quote ,child)) - (derived-mode-set-abbrev-table (quote ,child)) + (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 setup function, if -;;; ; any -- this will soon be -;;; ; obsolete. -;;; (derived-mode-run-setup-function (quote ,child)) + ,@body) ; Run the hooks, if any. - (derived-mode-run-hooks (quote ,child)))))) + (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)) ;; PUBLIC: find the ultimate class of a derived mode. (defun derived-mode-class (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." +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." (while (get mode 'derived-mode-parent) (setq mode (get mode 'derived-mode-parent))) mode) -;; Inline functions to construct various names from a mode name. - -(defsubst derived-mode-setup-function-name (mode) - "Construct a setup-function name based on a MODE name." - (intern (concat (symbol-name mode) "-setup"))) +;;; PRIVATE (defsubst derived-mode-hook-name (mode) "Construct the mode hook name based on mode name MODE." @@ -206,6 +222,56 @@ "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." + + (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))) + + (unless (stringp docstring) + ;; Use a default docstring. + (setq docstring + (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))) + + (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) + "\n\nThis mode " + (concat + "\n\nIn addition to any hooks its parent mode " + (if (string-match (regexp-quote (format "`%s'" parent)) + docstring) nil + (format "`%s' " parent)) + "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) "}"))) + + docstring)) + + +;;; OBSOLETE +;; The functions below are only provided for backward compatibility with +;; code byte-compiled with versions of derived.el prior to Emacs-21. + +(defsubst derived-mode-setup-function-name (mode) + "Construct a setup-function name based on a MODE name." + (intern (concat (symbol-name mode) "-setup"))) + ;; Utility functions for defining a derived mode. @@ -240,22 +306,6 @@ (define-abbrev-table (derived-mode-abbrev-table-name mode) nil) (make-abbrev-table)) ,(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)) - ;; Utility functions for running a derived mode. @@ -298,7 +348,6 @@ (defun derived-mode-run-hooks (mode) "Run the mode hook for MODE." - (let ((hooks-name (derived-mode-hook-name mode))) (if (boundp hooks-name) (run-hooks hooks-name))))