comparison lisp/derived.el @ 40344:d184455da497

(derived-mode-hook-name, derived-mode-map-name) (derived-mode-syntax-table-name, derived-mode-abbrev-table-name): define defsubsts before they are first used

40343:25129ef47b45

;; sense.  Second, it is possible to build even further, and make
;; a derived mode from a derived mode.  The commands
;;
;;   (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
;; 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
(defmacro define-derived-mode (child parent name &optional docstring &rest body)

  (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-syntax-table))
       (defvar ,abbrev)
       (define-abbrev-table ',abbrev nil)
       (put ',child 'derived-mode-parent ',parent)
     
       (defun ,child ()
	 ,docstring
	 (interactive)
					; Run the parent.
	 (delay-mode-hooks

		   (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

  mode)


;;; 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."

  (let ((map (derived-mode-map-name child))
	(syntax (derived-mode-syntax-table-name child))

  `%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 (null 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))

       (lambda (symbol)
	 (or (intern-soft (symbol-name symbol) new)
	     (define-abbrev new (symbol-name symbol)
	       (symbol-value symbol) (symbol-function symbol))))
       old)))
    
(provide 'derived)

;;; derived.el ends here

40344:d184455da497

;; sense.  Second, it is possible to build even further, and make
;; a derived mode from a derived mode.  The commands
;;
;;   (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
;; 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:

;;; 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
(defmacro define-derived-mode (child parent name &optional docstring &rest body)

  (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-syntax-table))
       (defvar ,abbrev)
       (define-abbrev-table ',abbrev nil)
       (put ',child 'derived-mode-parent ',parent)

       (defun ,child ()
	 ,docstring
	 (interactive)
					; Run the parent.
	 (delay-mode-hooks

		   (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

  mode)


;;; PRIVATE

(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))

  `%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 (null 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))

       (lambda (symbol)
	 (or (intern-soft (symbol-name symbol) new)
	     (define-abbrev new (symbol-name symbol)
	       (symbol-value symbol) (symbol-function symbol))))
       old)))

(provide 'derived)

;;; derived.el ends here