# HG changeset patch
# User Stefan Monnier <monnier@iro.umontreal.ca>
# Date 959987129 0
# Node ID addeae19bf96b102887b5a3d8813de62db8cd7c6
# Parent  8a911c1820352bd188d7bf44a476b3043186fa4d
(easy-mmode-derive-name): New function.
(easy-mmode-define-toggle, define-minor-mode): Use it.
(easy-mmode-define-keymap): Docstring fix.
(define-derived-mode): Default PARENT to fundamental-mode.
Add the derived-mode-parent symbol-property.
(easy-mmode-derived-mode-p): New function.

diff -r 8a911c182035 -r addeae19bf96 lisp/emacs-lisp/easy-mmode.el
--- a/lisp/emacs-lisp/easy-mmode.el	Fri Jun 02 23:03:31 2000 +0000
+++ b/lisp/emacs-lisp/easy-mmode.el	Fri Jun 02 23:05:29 2000 +0000
@@ -57,6 +57,7 @@
 optional DOC is its associated documentation.
 BODY is executed after the toggling and before running MODE-hook."
   (let* ((mode-name (symbol-name mode))
+	 (pretty-name (easy-mmode-derive-name mode-name))
 	 (hook (intern (concat mode-name "-hook")))
 	 (hook-on (intern (concat mode-name "-on-hook")))
 	 (hook-off (intern (concat mode-name "-off-hook")))
@@ -64,7 +65,7 @@
 			 (format "With no argument, toggle %s.
 With universal prefix ARG turn mode on.
 With zero or negative ARG turn mode off.
-\\{%s}" mode-name (concat mode-name "-map")))))
+\\{%s}" pretty-name (concat mode-name "-map")))))
     `(progn
        (defcustom ,hook  nil
 	 ,(format "Hook called at the end of function `%s'." mode-name)
@@ -82,13 +83,14 @@
 	 (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
 	 ;; Return the new setting.
 	 (if (interactive-p)
-	     (message ,(format "%s %%sabled"
-			       (replace-regexp-in-string
-				"-Mode" " mode"
-				(capitalize (symbol-name mode)) t))
+	     (message ,(format "%s %%sabled" pretty-name)
 		      (if ,mode "en" "dis")))
 	 ,mode))))
 
+(defun easy-mmode-derive-name (mode)
+  (replace-regexp-in-string
+   "-Mode" " mode" (capitalize (symbol-name mode)) t))
+
 ;;;###autoload
 (defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
 ;;;###autoload
@@ -118,9 +120,11 @@
     `(progn
        ;; Define the variable to enable or disable the mode.
        ,(if globalp
-	    `(defcustom ,mode ,init-value ,(format "Toggle %s.
+	    `(defcustom ,mode ,init-value
+	       ,(format "Toggle %s.
 Setting this variable directly does not take effect;
-use either \\[customize] or the function `%s'." mode mode)
+use either \\[customize] or the function `%s'."
+			(easy-mmode-derive-name mode) mode)
 	       :set (lambda (symbol value) (funcall symbol (or value 0)))
 	       :initialize 'custom-initialize-default
 	       :type 'boolean)
@@ -166,9 +170,9 @@
 (defun easy-mmode-define-keymap (bs &optional name m args)
   "Return a keymap built from bindings BS.
 BS must be a list of (KEY . BINDING) where
-KEY and BINDINGS are suited as for define-key.
-optional NAME is passed to `make-sparse-keymap'.
-optional map M can be used to modify an existing map.
+KEY and BINDINGS are suitable for `define-key'.
+Optional NAME is passed to `make-sparse-keymap'.
+Optional map M can be used to modify an existing map.
 ARGS is a list of additional arguments."
   (let (inherit dense suppress)
     (while args
@@ -273,6 +277,8 @@
 	 (abbrev (intern (concat child-name "-abbrev-table")))
 	 (hook (intern (concat child-name "-hook"))))
 	 
+    (unless parent (setq parent 'fundamental-mode))
+
     (when (and docstring (not (stringp docstring)))
       ;; DOCSTRING is really the first command and there's no docstring
       (push docstring body)
@@ -311,6 +317,7 @@
        (defvar ,map (make-sparse-keymap))
        (defvar ,syntax (make-char-table 'syntax-table nil))
        (defvar ,abbrev (progn (define-abbrev-table ',abbrev nil) ,abbrev))
+       (put ',child 'derived-mode-parent ',parent)
      
        (defun ,child ()
 	 ,docstring
@@ -346,6 +353,15 @@
 					; Run the hooks, if any.
 	 (run-hooks ',hook)))))
 
+;; Inspired from derived-mode-class in derived.el
+(defun easy-mmode-derived-mode-p (mode)
+  "Non-nil if the current major mode is derived from MODE.
+Uses the `derived-mode-parent' property of the symbol to trace backwards."
+  (let ((parent major-mode))
+    (while (and (not (eq parent mode))
+		(setq parent (get parent 'derived-mode-parent))))
+    parent))
+
 
 ;;;
 ;;; easy-mmode-define-navigation