]> code.delx.au - gnu-emacs/blobdiff - lisp/ehelp.el
Add 2008 to copyright years.
[gnu-emacs] / lisp / ehelp.el
index 00e16b657c1ae52f281e5a0787fd00f39b9194c5..d6193c9cf43f3c3f93ffb0070bd11c41cd181768 100644 (file)
@@ -1,6 +1,7 @@
 ;;; ehelp.el --- bindings for electric-help mode
 
-;; Copyright (C) 1986 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1995, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, extensions
@@ -9,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 ;; This package provides a pre-packaged `Electric Help Mode' for
 ;; browsing on-line help screens.  There is one entry point,
-;; `with-electric-help'; All you have to give it is a no-argument
-;; function that generates the actual text of the help into the urrent
+;; `with-electric-help'; all you have to give it is a no-argument
+;; function that generates the actual text of the help into the current
 ;; buffer.
 
+;; To make this the default, you must do
+;; (require 'ehelp)
+;; (define-key global-map "\C-h" 'ehelp-command)
+;; (define-key global-map [help] 'ehelp-command)
+;; (define-key global-map [f1] 'ehelp-command)
+
 ;;; Code:
 
 (require 'electric)
 (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
     ()
   (let ((map (make-keymap)))
-    (fillarray (car (cdr map)) 'electric-help-undefined)
-    (define-key map (char-to-string meta-prefix-char) (copy-keymap map))
+    ;; allow all non-self-inserting keys - search, scroll, etc, but
+    ;; let M-x and C-x exit ehelp mode and retain buffer:
+    (suppress-keymap map)
+    (define-key map "\C-u" 'electric-help-undefined)
+    (define-key map [?\C-0] 'electric-help-undefined)
+    (define-key map [?\C-1] 'electric-help-undefined)
+    (define-key map [?\C-2] 'electric-help-undefined)
+    (define-key map [?\C-3] 'electric-help-undefined)
+    (define-key map [?\C-4] 'electric-help-undefined)
+    (define-key map [?\C-5] 'electric-help-undefined)
+    (define-key map [?\C-6] 'electric-help-undefined)
+    (define-key map [?\C-7] 'electric-help-undefined)
+    (define-key map [?\C-8] 'electric-help-undefined)
+    (define-key map [?\C-9] 'electric-help-undefined)
     (define-key map (char-to-string help-char) 'electric-help-help)
     (define-key map "?" 'electric-help-help)
     (define-key map " " 'scroll-up)
     (define-key map "<" 'beginning-of-buffer)
     (define-key map ">" 'end-of-buffer)
     ;(define-key map "\C-g" 'electric-help-exit)
-    (define-key map "q" 'electric-help-exit)
     (define-key map "Q" 'electric-help-exit)
+    (define-key map "q" 'electric-help-exit)
     ;;a better key than this?
+    (define-key map "R" 'electric-help-retain)
     (define-key map "r" 'electric-help-retain)
+    (define-key map "\ex" 'electric-help-execute-extended)
+    (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
 
     (setq electric-help-map map)))
-   
+
 (defun electric-help-mode ()
   "`with-electric-help' temporarily places its buffer in this mode.
 \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
   (setq major-mode 'help)
   (setq mode-line-buffer-identification '(" Help:  %b"))
   (use-local-map electric-help-map)
+  (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)
   )
 
-(defun with-electric-help (thunk &optional buffer noerase)
-  "Arguments are THUNK &optional BUFFER NOERASE.  BUFFER defaults to \"*Help*\"
-THUNK is a function of no arguments which is called to initialize
-the contents of BUFFER.  BUFFER will be erased before THUNK is called unless
-NOERASE is non-nil.  THUNK will be called with `standard-output' bound to
-the buffer specified by BUFFER
+;;;###autoload
+(defun with-electric-help (thunk &optional buffer noerase minheight)
+  "Pop up an \"electric\" help buffer.
+THUNK is a function of no arguments which is called to initialize the
+contents of BUFFER.  BUFFER defaults to `*Help*'.  BUFFER will be
+erased before THUNK is called unless NOERASE is non-nil.  THUNK will
+be called while BUFFER is current and with `standard-output' bound to
+the buffer specified by BUFFER.
+
+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.
 
 After THUNK has been called, this function \"electrically\" pops up a window
 in which BUFFER is displayed and allows the user to scroll through that buffer
-in electric-help-mode.
-When the user exits (with `electric-help-exit', or otherwise) the help
-buffer's window disappears (i.e., we use `save-window-excursion')
-BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit"
+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 `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'), and
+BUFFER is put into `default-major-mode' (or `fundamental-mode')."
   (setq buffer (get-buffer-create (or buffer "*Help*")))
   (let ((one (one-window-p t))
        (config (current-window-configuration))
-        (bury nil))
+        (bury 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)
+             (when (and minheight (< (window-height) minheight))
+              (enlarge-window (- minheight (window-height))))
              (electric-help-mode)
-             (setq buffer-read-only nil)
-             (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))))))
+      (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 "<<< Press Space to bury the help buffer >>>")
+       (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)))
-                         '(?\ ))
+                         '(?\s))
                   (progn (setq unread-command-events nil)
                          (throw 'exit t)))))
     (let (up down both neither
-         (standard (and (eq (key-binding " ")
+         (standard (and (eq (key-binding " " nil t)
                             'scroll-up)
-                        (eq (key-binding "\^?")
+                        (eq (key-binding "\^?" nil t)
                             'scroll-down)
-                        (eq (key-binding "Q")
+                        (eq (key-binding "q" nil t)
                             'electric-help-exit)
-                        (eq (key-binding "q")
-                            'electric-help-exit))))
+                        (eq (key-binding "r" nil t)
+                            'electric-help-retain))))
       (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
+                     ;will yield a wrong result.
          (let ((min (pos-visible-in-window-p (point-min)))
-               (max (pos-visible-in-window-p (point-max))))
-           (cond ((and min max)
-                  (cond (standard "Press Q to exit ")
+               (max (pos-visible-in-window-p (1- (point-max)))))
+           (cond (isearch-mode 'noprompt)
+                 ((and min max)
+                  (cond (standard "Press q to exit, r to retain ")
                         (neither)
-                        (t (setq neither (substitute-command-keys "Press \\[scroll-up] to exit ")))))
+                        (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
                  (min
-                  (cond (standard "Press SPC to scroll, Q to exit ")
+                  (cond (standard "Press SPC to scroll, q to exit, r to retain ")
                         (up)
-                        (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll; \\[electric-help-exit] to exit ")))))
+                        (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
                  (max
-                  (cond (standard "Press DEL to scroll back, Q to exit ")
+                  (cond (standard "Press DEL to scroll back, q to exit, r to retain ")
                         (down)
-                        (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[scroll-up] to exit ")))))
+                        (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
                  (t
-                  (cond (standard "Press SPC to scroll, DEL to scroll back, Q to exit ")
+                  (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
                         (both)
-                        (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit ")))))))))
+                        (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))))
                    t))))
 
 
@@ -173,43 +245,53 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit"
 ;    (scroll-up arg)))
 
 (defun electric-help-exit ()
-  ">>>Doc"
+  "Exit `with-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.
+  "Exit `with-electric-help', retaining the current window/buffer configuration.
 \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
 will select it.)"
   (interactive)
-  (throw 'exit '(retain)))
+  ;; 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 '(retain)))))
 
 
 (defun electric-help-undefined ()
   (interactive)
   (error "%s is undefined -- Press %s to exit"
         (mapconcat 'single-key-description (this-command-keys) " ")
-        (if (eq (key-binding "Q") 'electric-help-exit)
-            "Q"
+        (if (eq (key-binding "q" nil t) 'electric-help-exit)
+            "q"
           (substitute-command-keys "\\[electric-help-exit]"))))
 
 
 ;>>> this needs to be hairified (recursive help, anybody?)
 (defun electric-help-help ()
   (interactive)
-  (if (and (eq (key-binding "Q") 'electric-help-exit)
-          (eq (key-binding " ") 'scroll-up)
-          (eq (key-binding "\^?") 'scroll-down))
-      (message "SPC scrolls forward, DEL scrolls back, Q exits and burys help buffer")
-    ;; to give something for user to look at while slow substitute-cmd-keys
-    ;;  grinds away
-    (message "Help...")
-    (message "%s" (substitute-command-keys "\\[scroll-up] scrolls forward, \\[scroll-down] scrolls back, \\[electric-help-exit] exits.")))
+  (if (and (eq (key-binding "q" nil t) 'electric-help-exit)
+          (eq (key-binding " " nil t) 'scroll-up)
+          (eq (key-binding "\^?" nil t) 'scroll-down)
+          (eq (key-binding "r" nil t) 'electric-help-retain))
+      (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
+    (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
   (sit-for 2))
 
 \f
-(defun electric-helpify (fun)
-  (let ((name "*Help*"))
+;;;###autoload
+(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))
@@ -259,6 +341,22 @@ will select it.)"
                     (set-buffer-modified-p m))))))
        (with-electric-help 'ignore name t))))
 
+\f
+
+;; 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 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 electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
+  (electric-help-retain))
+
 \f
 (defun electric-describe-key ()
   (interactive)
@@ -295,10 +393,13 @@ 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)
 
+(defun electric-apropos ()
+  (interactive)
+  (electric-helpify 'apropos))
 
 \f
 ;;;; ehelp-map
@@ -306,7 +407,9 @@ 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)
     (substitute-key-definition 'describe-mode 'electric-describe-mode map)
     (substitute-key-definition 'view-lossage 'electric-view-lossage map)
@@ -315,11 +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)))
 
-;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
+;;;###(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