Add arch taglines
[bpt/emacs.git] / lisp / ehelp.el
index fec1dfc..12ebbeb 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ehelp.el --- bindings for electric-help mode
 
-;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1995, 2000, 2001 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, extensions
 (defvar electric-help-map ()
   "Keymap defining commands available in `electric-help-mode'.")
 
+(defvar electric-help-form-to-execute nil)
+
+(defgroup electric-help ()
+  "Electric help facility."
+  :version "21.1"
+  :group 'help)
+
+(defcustom electric-help-shrink-window t
+  "If set, adjust help window sizes to buffer sizes when displaying help."
+  :type 'boolean
+  :group 'electric-help)
+
+(defcustom electric-help-mode-hook nil
+  "Hook run by `with-electric-help' after initializing the buffer."
+  :type 'hook
+  :group 'electric-help)
+
 (put 'electric-help-undefined 'suppress-keymap t)
 (if electric-help-map
     ()
   (setq major-mode 'help)
   (setq mode-line-buffer-identification '(" Help:  %b"))
   (use-local-map electric-help-map)
-  (setq mouse-leave-buffer-hook '(electric-help-retain))
+  (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+  (view-mode -1)
   ;; this is done below in with-electric-help
   ;(run-hooks 'electric-help-mode-hook)
   )
@@ -110,61 +128,73 @@ in electric-help-mode. The window's height will be at least MINHEIGHT if
 this value is non-nil.
 
 If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those
-things.
+shrink the window to fit if `electric-help-shrink-window' is non-nil.
+If THUNK returns non-nil, we don't do those things.
 
-When the user exits (with `electric-help-exit', or otherwise) the help
-buffer's window disappears (i.e., we use `save-window-excursion')
+When the user exits (with `electric-help-exit', or otherwise), the help
+buffer's window disappears (i.e., we use `save-window-excursion'), and
 BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
   (setq buffer (get-buffer-create (or buffer "*Help*")))
   (let ((one (one-window-p t))
        (config (current-window-configuration))
         (bury nil)
-        (to-be-executed nil))
+        (electric-help-form-to-execute nil))
     (unwind-protect
          (save-excursion
-           (if one (goto-char (window-start (selected-window))))
+           (when one
+            (goto-char (window-start (selected-window))))
            (let ((pop-up-windows t))
              (pop-to-buffer buffer))
            (save-excursion
              (set-buffer buffer)
-             (if (and minheight (< (window-height) minheight))
-                 (enlarge-window (- minheight (window-height))))
+             (when (and minheight (< (window-height) minheight))
+              (enlarge-window (- minheight (window-height))))
              (electric-help-mode)
-             (or noerase (erase-buffer)))
+            (setq buffer-read-only nil)
+            (unless noerase
+              (erase-buffer)))
            (let ((standard-output buffer))
-             (if (not (funcall thunk))
-                 (progn
-                   (set-buffer buffer)
-                   (set-buffer-modified-p nil)
-                   (goto-char (point-min))
-                   (if one (shrink-window-if-larger-than-buffer (selected-window))))))
+             (unless (funcall thunk)
+              (set-buffer buffer)
+              (set-buffer-modified-p nil)
+              (goto-char (point-min))
+              (when (and one electric-help-shrink-window)
+                (shrink-window-if-larger-than-buffer))))
            (set-buffer buffer)
            (run-hooks 'electric-help-mode-hook)
-           (if (eq (car-safe (electric-help-command-loop))
-                   'retain)
+          (setq buffer-read-only t)
+           (if (eq (car-safe (electric-help-command-loop)) 'retain)
                (setq config (current-window-configuration))
-               (setq bury t)))
+            (setq bury t))
+          ;; Remove the hook.
+          (when (memq 'electric-help-retain mouse-leave-buffer-hook)
+            (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)))
       (message "")
       (set-buffer buffer)
       (setq buffer-read-only nil)
+
+      ;; We should really get a usable *Help* buffer when retaining
+      ;; the electric one with `r'.  The problem is that a simple
+      ;; call to help-mode won't cut it; at least RET is bound wrong
+      ;; afterwards.  It's also not clear that `help-mode' is always
+      ;; the right thing, maybe we should add an optional parameter.
       (condition-case ()
           (funcall (or default-major-mode 'fundamental-mode))
         (error nil))
+
       (set-window-configuration config)
-      (if bury
-          (progn
-            ;;>> Perhaps this shouldn't be done.
-            ;; so that when we say "Press space to bury" we mean it
-            (replace-buffer-in-windows buffer)
-            ;; must do this outside of save-window-excursion
-            (bury-buffer buffer)))
-      (eval to-be-executed))))
+      (when bury
+       ;;>> Perhaps this shouldn't be done,
+       ;; so that when we say "Press space to bury" we mean it
+       (replace-buffer-in-windows buffer)
+       ;; must do this outside of save-window-excursion
+       (bury-buffer buffer))
+      (eval electric-help-form-to-execute))))
 
 (defun electric-help-command-loop ()
   (catch 'exit
     (if (pos-visible-in-window-p (point-max))
-       (progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
+       (progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
               (if (equal (setq unread-command-events (list (read-event)))
                          '(?\ ))
                   (progn (setq unread-command-events nil)
@@ -181,8 +211,8 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
       (Electric-command-loop
         'exit
        (function (lambda ()
-         (sit-for 0) ;necessary if last command was end-of-buffer or 
-                     ;beginning-of-buffer - otherwise pos-visible-in-window-p 
+         (sit-for 0) ;necessary if last command was end-of-buffer or
+                     ;beginning-of-buffer - otherwise pos-visible-in-window-p
                      ;will yield a wrong result.
          (let ((min (pos-visible-in-window-p (point-min)))
                (max (pos-visible-in-window-p (point-max))))
@@ -215,9 +245,15 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
 ;    (scroll-up arg)))
 
 (defun electric-help-exit ()
-  ">>>Doc"
+  "Exit `electric-help', restoring the previous window/buffer configuration.
+\(The *Help* buffer will be buried.)"
   (interactive)
-  (throw 'exit t))
+  ;; Make sure that we don't throw twice, even if two events cause
+  ;; calling this function:
+  (if (memq 'electric-help-retain mouse-leave-buffer-hook)
+      (progn
+       (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+       (throw 'exit t))))
 
 (defun electric-help-retain ()
   "Exit `electric-help', retaining the current window/buffer configuration.
@@ -226,10 +262,10 @@ will select it.)"
   (interactive)
   ;; Make sure that we don't throw twice, even if two events cause
   ;; calling this function:
-  (if mouse-leave-buffer-hook
-    (progn
-      (setq mouse-leave-buffer-hook nil)
-      (throw 'exit '(retain)))))
+  (if (memq 'electric-help-retain mouse-leave-buffer-hook)
+      (progn
+       (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+       (throw 'exit '(retain)))))
 
 
 (defun electric-help-undefined ()
@@ -254,8 +290,8 @@ will select it.)"
 
 \f
 ;;;###autoload
-(defun electric-helpify (fun)
-  (let ((name "*Help*"))
+(defun electric-helpify (fun &optional name)
+  (let ((name (or name "*Help*")))
     (if (save-window-excursion
          ;; kludge-o-rama
          (let* ((p (symbol-function 'print-help-return-message))
@@ -307,18 +343,18 @@ will select it.)"
 
 \f
 
-;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then 
+;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then
 ;; continues with execute-extended-command.
 (defun electric-help-execute-extended (prefixarg)
   (interactive "p")
-  (setq to-be-executed '(execute-extended-command nil))
+  (setq electric-help-form-to-execute '(execute-extended-command nil))
   (electric-help-retain))
 
 ;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
 ;; continues with ctrl-x prefix.
 (defun electric-help-ctrl-x-prefix (prefixarg)
   (interactive "p")
-  (setq to-be-executed '(progn (message nil) (setq unread-command-char ?\C-x)))
+  (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
   (electric-help-retain))
 
 \f
@@ -357,7 +393,7 @@ will select it.)"
 
 (defun electric-command-apropos ()
   (interactive)
-  (electric-helpify 'command-apropos))
+  (electric-helpify 'command-apropos "*Apropos*"))
 
 ;(define-key help-map "a" 'electric-command-apropos)
 
@@ -371,7 +407,7 @@ will select it.)"
 (defvar ehelp-map ())
 (if ehelp-map
     nil
-  (let ((map (copy-keymap help-map))) 
+  (let ((map (copy-keymap help-map)))
     (substitute-key-definition 'apropos 'electric-apropos map)
     (substitute-key-definition 'command-apropos 'electric-command-apropos map)
     (substitute-key-definition 'describe-key 'electric-describe-key map)
@@ -382,9 +418,13 @@ will select it.)"
     (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
     (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
 
-    (setq ehelp-map map)
-    (fset 'ehelp-command map)))
+    (setq ehelp-map map)))
+
+;;;###(autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap)
+(defalias 'ehelp-command ehelp-map)
+(put 'ehelp-command 'documentation "Prefix command for ehelp.")
 
-(provide 'ehelp) 
+(provide 'ehelp)
 
+;;; arch-tag: e0e3037f-42c0-433e-ba18-322c5d951f46
 ;;; ehelp.el ends here