X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e516799970be4553edae8ca46d5f64852befec77..d8ea53f999a0b53278b9dd59f7902d325edbd45b:/lisp/ehelp.el diff --git a/lisp/ehelp.el b/lisp/ehelp.el index 713a8984ac..d0dfd8d6be 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -1,9 +1,10 @@ ;;; ehelp.el --- bindings for electric-help mode -;; Maintainer: FSF -;; Last-Modified: 16 Mar 1992 +;; Copyright (C) 1986, 1995, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. -;; Copyright (C) 1986 Free Software Foundation, Inc. +;; Maintainer: FSF +;; Keywords: help, extensions ;; This file is part of GNU Emacs. @@ -18,8 +19,23 @@ ;; 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 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: @@ -27,12 +43,41 @@ (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 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) @@ -41,13 +86,16 @@ (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'.)" @@ -56,102 +104,136 @@ (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. +The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT. +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') when we exit." (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 >>>") - (if (= (setq unread-command-char (read-char)) ?\ ) - (progn (setq unread-command-char -1) + (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) (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)))) @@ -164,43 +246,53 @@ 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. \(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)) -(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)) @@ -250,6 +342,22 @@ will select it.)" (set-buffer-modified-p m)))))) (with-electric-help 'ignore name t)))) + + +;; 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)) + (defun electric-describe-key () (interactive) @@ -286,10 +394,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)) ;;;; ehelp-map @@ -297,7 +408,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) @@ -306,11 +419,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