X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/483a5ec09ebdb7f42584d6b274ffa92e543b4383..27422a9d8a01ea0658d689be824936674bb20d6e:/lisp/ehelp.el diff --git a/lisp/ehelp.el b/lisp/ehelp.el index b314927e8f..d0dfd8d6be 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -1,6 +1,7 @@ ;;; ehelp.el --- bindings for electric-help mode -;; Copyright (C) 1986, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1995, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, extensions @@ -18,8 +19,9 @@ ;; 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: @@ -41,6 +43,23 @@ (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 () @@ -67,11 +86,11 @@ (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 "r" 'electric-help-retain) (define-key map "\ex" 'electric-help-execute-extended) (define-key map "\C-x" 'electric-help-ctrl-x-prefix) @@ -85,7 +104,8 @@ (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) ) @@ -109,82 +129,94 @@ 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) (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 "r") + (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 + (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)))) + (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 ") @@ -214,9 +246,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. @@ -225,17 +263,17 @@ 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 () (interactive) (error "%s is undefined -- Press %s to exit" (mapconcat 'single-key-description (this-command-keys) " ") - (if (eq (key-binding "q") 'electric-help-exit) + (if (eq (key-binding "q" nil t) 'electric-help-exit) "q" (substitute-command-keys "\\[electric-help-exit]")))) @@ -243,18 +281,18 @@ will select it.)" ;>>> 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) - (eq (key-binding "r") 'electric-help-retain)) + (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)) ;;;###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)) @@ -306,18 +344,18 @@ will select it.)" -;; 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)) @@ -356,7 +394,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) @@ -370,7 +408,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) @@ -381,9 +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))) + +;;;###(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