lisp/ehelp.el

   1 ;;; ehelp.el --- bindings for electric-help mode
   2
   3 ;; Copyright (C) 1986, 1995, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   7 ;; Keywords: help, extensions
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This package provides a pre-packaged `Electric Help Mode' for
  27 ;; browsing on-line help screens.  There is one entry point,
  28 ;; `with-electric-help'; all you have to give it is a no-argument
  29 ;; function that generates the actual text of the help into the current
  30 ;; buffer.
  31
  32 ;; To make this the default, you must do
  33 ;; (require 'ehelp)
  34 ;; (define-key global-map "\C-h" 'ehelp-command)
  35 ;; (define-key global-map [help] 'ehelp-command)
  36 ;; (define-key global-map [f1] 'ehelp-command)
  37
  38 ;;; Code:
  39
  40 (require 'electric)
  41
  42 (defvar electric-help-form-to-execute nil)
  43
  44 (defgroup electric-help ()
  45   "Electric help facility."
  46   :version "21.1"
  47   :group 'help)
  48
  49 (defcustom electric-help-shrink-window t
  50   "If set, adjust help window sizes to buffer sizes when displaying help."
  51   :type 'boolean
  52   :group 'electric-help)
  53
  54 (defcustom electric-help-mode-hook nil
  55   "Hook run by `with-electric-help' after initializing the buffer."
  56   :type 'hook
  57   :group 'electric-help)
  58
  59 (put 'electric-help-undefined 'suppress-keymap t)
  60
  61 (defvar electric-help-map
  62   (let ((map (make-keymap)))
  63     ;; allow all non-self-inserting keys - search, scroll, etc, but
  64     ;; let M-x and C-x exit ehelp mode and retain buffer:
  65     (suppress-keymap map)
  66     (define-key map "\C-u" 'electric-help-undefined)
  67     (define-key map [?\C-0] 'electric-help-undefined)
  68     (define-key map [?\C-1] 'electric-help-undefined)
  69     (define-key map [?\C-2] 'electric-help-undefined)
  70     (define-key map [?\C-3] 'electric-help-undefined)
  71     (define-key map [?\C-4] 'electric-help-undefined)
  72     (define-key map [?\C-5] 'electric-help-undefined)
  73     (define-key map [?\C-6] 'electric-help-undefined)
  74     (define-key map [?\C-7] 'electric-help-undefined)
  75     (define-key map [?\C-8] 'electric-help-undefined)
  76     (define-key map [?\C-9] 'electric-help-undefined)
  77     (define-key map (char-to-string help-char) 'electric-help-help)
  78     (define-key map "?" 'electric-help-help)
  79     (define-key map " " 'scroll-up)
  80     (define-key map "\^?" 'scroll-down)
  81     (define-key map "." 'beginning-of-buffer)
  82     (define-key map "<" 'beginning-of-buffer)
  83     (define-key map ">" 'end-of-buffer)
  84     ;(define-key map "\C-g" 'electric-help-exit)
  85     (define-key map "Q" 'electric-help-exit)
  86     (define-key map "q" 'electric-help-exit)
  87     ;;a better key than this?
  88     (define-key map "R" 'electric-help-retain)
  89     (define-key map "r" 'electric-help-retain)
  90     (define-key map "\ex" 'electric-help-execute-extended)
  91     (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
  92     map)
  93   "Keymap defining commands available in `electric-help-mode'.")
  94
  95 (defun electric-help-mode ()
  96   "`with-electric-help' temporarily places its buffer in this mode.
  97 \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
  98   (setq buffer-read-only t)
  99   (setq mode-name "Help")
 100   (setq major-mode 'help)
 101   (setq mode-line-buffer-identification '(" Help:  %b"))
 102   (use-local-map electric-help-map)
 103   (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
 104   (view-mode -1)
 105   ;; this is done below in with-electric-help
 106   ;(run-hooks 'electric-help-mode-hook)
 107   )
 108
 109 ;;;###autoload
 110 (defun with-electric-help (thunk &optional buffer noerase minheight)
 111   "Pop up an \"electric\" help buffer.
 112 THUNK is a function of no arguments which is called to initialize the
 113 contents of BUFFER.  BUFFER defaults to `*Help*'.  BUFFER will be
 114 erased before THUNK is called unless NOERASE is non-nil.  THUNK will
 115 be called while BUFFER is current and with `standard-output' bound to
 116 the buffer specified by BUFFER.
 117
 118 If THUNK returns nil, we display BUFFER starting at the top, and shrink
 119 the window to fit.  If THUNK returns non-nil, we don't do those things.
 120
 121 After THUNK has been called, this function \"electrically\" pops up a
 122 window in which BUFFER is displayed and allows the user to scroll
 123 through that buffer in `electric-help-mode'.  The window's height will
 124 be at least MINHEIGHT if this value is non-nil.
 125
 126 If THUNK returns nil, we display BUFFER starting at the top, and
 127 shrink the window to fit if `electric-help-shrink-window' is non-nil.
 128 If THUNK returns non-nil, we don't do those things.
 129
 130 When the user exits (with `electric-help-exit', or otherwise), the help
 131 buffer's window disappears (i.e., we use `save-window-excursion'), and
 132 BUFFER is put into `default-major-mode' (or `fundamental-mode')."
 133   (setq buffer (get-buffer-create (or buffer "*Help*")))
 134   (let ((one (one-window-p t))
 135         (config (current-window-configuration))
 136         (bury nil)
 137         (electric-help-form-to-execute nil))
 138     (unwind-protect
 139          (save-excursion
 140            (when one
 141              (goto-char (window-start (selected-window))))
 142            (let ((pop-up-windows t))
 143              (pop-to-buffer buffer))
 144            (save-excursion
 145              (set-buffer buffer)
 146              (when (and minheight (< (window-height) minheight))
 147                (enlarge-window (- minheight (window-height))))
 148              (electric-help-mode)
 149              (setq buffer-read-only nil)
 150              (unless noerase
 151                (erase-buffer)))
 152            (let ((standard-output buffer))
 153              (unless (funcall thunk)
 154                (set-buffer buffer)
 155                (set-buffer-modified-p nil)
 156                (goto-char (point-min))
 157                (when (and one electric-help-shrink-window)
 158                  (shrink-window-if-larger-than-buffer))))
 159            (set-buffer buffer)
 160            (run-hooks 'electric-help-mode-hook)
 161            (setq buffer-read-only t)
 162            (if (eq (car-safe (electric-help-command-loop)) 'retain)
 163                (setq config (current-window-configuration))
 164              (setq bury t))
 165            ;; Remove the hook.
 166            (when (memq 'electric-help-retain mouse-leave-buffer-hook)
 167              (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)))
 168       (message "")
 169       (set-buffer buffer)
 170       (setq buffer-read-only nil)
 171
 172       ;; We should really get a usable *Help* buffer when retaining
 173       ;; the electric one with `r'.  The problem is that a simple
 174       ;; call to help-mode won't cut it; at least RET is bound wrong
 175       ;; afterwards.  It's also not clear that `help-mode' is always
 176       ;; the right thing, maybe we should add an optional parameter.
 177       (condition-case ()
 178           (funcall (or default-major-mode 'fundamental-mode))
 179         (error nil))
 180
 181       (set-window-configuration config)
 182       (when bury
 183         ;;>> Perhaps this shouldn't be done,
 184         ;; so that when we say "Press space to bury" we mean it
 185         (replace-buffer-in-windows buffer)
 186         ;; must do this outside of save-window-excursion
 187         (bury-buffer buffer))
 188       (eval electric-help-form-to-execute))))
 189
 190 (defun electric-help-command-loop ()
 191   (catch 'exit
 192     (if (pos-visible-in-window-p (point-max))
 193         (progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
 194                (if (equal (setq unread-command-events (list (read-event)))
 195                           '(?\s))
 196                    (progn (setq unread-command-events nil)
 197                           (throw 'exit t)))))
 198     (let (up down both neither
 199           (standard (and (eq (key-binding " " nil t)
 200                              'scroll-up)
 201                          (eq (key-binding "\^?" nil t)
 202                              'scroll-down)
 203                          (eq (key-binding "q" nil t)
 204                              'electric-help-exit)
 205                          (eq (key-binding "r" nil t)
 206                              'electric-help-retain))))
 207       (Electric-command-loop
 208         'exit
 209         (function (lambda ()
 210           (sit-for 0) ;necessary if last command was end-of-buffer or
 211                       ;beginning-of-buffer - otherwise pos-visible-in-window-p
 212                       ;will yield a wrong result.
 213           (let ((min (pos-visible-in-window-p (point-min)))
 214                 (max (pos-visible-in-window-p (1- (point-max)))))
 215             (cond (isearch-mode 'noprompt)
 216                   ((and min max)
 217                    (cond (standard "Press q to exit, r to retain ")
 218                          (neither)
 219                          (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
 220                   (min
 221                    (cond (standard "Press SPC to scroll, q to exit, r to retain ")
 222                          (up)
 223                          (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
 224                   (max
 225                    (cond (standard "Press DEL to scroll back, q to exit, r to retain ")
 226                          (down)
 227                          (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
 228                   (t
 229                    (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
 230                          (both)
 231                          (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 ")))))))))
 232                     t))))
 233
 234
 235 \f
 236 ;(defun electric-help-scroll-up (arg)
 237 ;  ">>>Doc"
 238 ;  (interactive "P")
 239 ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
 240 ;      (electric-help-exit)
 241 ;    (scroll-up arg)))
 242
 243 (defun electric-help-exit ()
 244   "Exit `with-electric-help', restoring the previous window/buffer configuration.
 245 \(The *Help* buffer will be buried.)"
 246   (interactive)
 247   ;; Make sure that we don't throw twice, even if two events cause
 248   ;; calling this function:
 249   (if (memq 'electric-help-retain mouse-leave-buffer-hook)
 250       (progn
 251         (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
 252         (throw 'exit t))))
 253
 254 (defun electric-help-retain ()
 255   "Exit `with-electric-help', retaining the current window/buffer configuration.
 256 \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
 257 will select it.)"
 258   (interactive)
 259   ;; Make sure that we don't throw twice, even if two events cause
 260   ;; calling this function:
 261   (if (memq 'electric-help-retain mouse-leave-buffer-hook)
 262       (progn
 263         (remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
 264         (throw 'exit '(retain)))))
 265
 266
 267 (defun electric-help-undefined ()
 268   (interactive)
 269   (error "%s is undefined -- Press %s to exit"
 270          (mapconcat 'single-key-description (this-command-keys) " ")
 271          (if (eq (key-binding "q" nil t) 'electric-help-exit)
 272              "q"
 273            (substitute-command-keys "\\[electric-help-exit]"))))
 274
 275
 276 ;>>> this needs to be hairified (recursive help, anybody?)
 277 (defun electric-help-help ()
 278   (interactive)
 279   (if (and (eq (key-binding "q" nil t) 'electric-help-exit)
 280            (eq (key-binding " " nil t) 'scroll-up)
 281            (eq (key-binding "\^?" nil t) 'scroll-down)
 282            (eq (key-binding "r" nil t) 'electric-help-retain))
 283       (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
 284     (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
 285   (sit-for 2))
 286
 287 \f
 288 ;;;###autoload
 289 (defun electric-helpify (fun &optional name)
 290   (let ((name (or name "*Help*")))
 291     (if (save-window-excursion
 292           ;; kludge-o-rama
 293           (let* ((p (symbol-function 'print-help-return-message))
 294                  (b (get-buffer name))
 295                  (m (buffer-modified-p b)))
 296             (and b (not (get-buffer-window b))
 297                  (setq b nil))
 298             (unwind-protect
 299                 (progn
 300                   (message "%s..." (capitalize (symbol-name fun)))
 301                   ;; with-output-to-temp-buffer marks the buffer as unmodified.
 302                   ;; kludging excessively and relying on that as some sort
 303                   ;;  of indication leads to the following abomination...
 304                   ;;>> This would be doable without such icky kludges if either
 305                   ;;>> (a) there were a function to read the interactive
 306                   ;;>>     args for a command and return a list of those args.
 307                   ;;>>     (To which one would then just apply the command)
 308                   ;;>>     (The only problem with this is that interactive-p
 309                   ;;>>      would break, but that is such a misfeature in
 310                   ;;>>      any case that I don't care)
 311                   ;;>>     It is easy to do this for emacs-lisp functions;
 312                   ;;>>     the only problem is getting the interactive spec
 313                   ;;>>     for subrs
 314                   ;;>> (b) there were a function which returned a
 315                   ;;>>     modification-tick for a buffer.  One could tell
 316                   ;;>>     whether a buffer had changed by whether the
 317                   ;;>>     modification-tick were different.
 318                   ;;>>     (Presumably there would have to be a way to either
 319                   ;;>>      restore the tick to some previous value, or to
 320                   ;;>>      suspend updating of the tick in order to allow
 321                   ;;>>      things like momentary-string-display)
 322                   (and b
 323                        (save-excursion
 324                          (set-buffer b)
 325                          (set-buffer-modified-p t)))
 326                   (fset 'print-help-return-message 'ignore)
 327                   (call-interactively fun)
 328                   (and (get-buffer name)
 329                        (get-buffer-window (get-buffer name))
 330                        (or (not b)
 331                            (not (eq b (get-buffer name)))
 332                            (not (buffer-modified-p b)))))
 333               (fset 'print-help-return-message p)
 334               (and b (buffer-name b)
 335                    (save-excursion
 336                      (set-buffer b)
 337                      (set-buffer-modified-p m))))))
 338         (with-electric-help 'ignore name t))))
 339
 340 \f
 341
 342 ;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then
 343 ;; continues with execute-extended-command.
 344 (defun electric-help-execute-extended (prefixarg)
 345   (interactive "p")
 346   (setq electric-help-form-to-execute '(execute-extended-command nil))
 347   (electric-help-retain))
 348
 349 ;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
 350 ;; continues with ctrl-x prefix.
 351 (defun electric-help-ctrl-x-prefix (prefixarg)
 352   (interactive "p")
 353   (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
 354   (electric-help-retain))
 355
 356 \f
 357 (defun electric-describe-key ()
 358   (interactive)
 359   (electric-helpify 'describe-key))
 360
 361 (defun electric-describe-mode ()
 362   (interactive)
 363   (electric-helpify 'describe-mode))
 364
 365 (defun electric-view-lossage ()
 366   (interactive)
 367   (electric-helpify 'view-lossage))
 368
 369 ;(defun electric-help-for-help ()
 370 ;  "See help-for-help"
 371 ;  (interactive)
 372 ;  )
 373
 374 (defun electric-describe-function ()
 375   (interactive)
 376   (electric-helpify 'describe-function))
 377
 378 (defun electric-describe-variable ()
 379   (interactive)
 380   (electric-helpify 'describe-variable))
 381
 382 (defun electric-describe-bindings ()
 383   (interactive)
 384   (electric-helpify 'describe-bindings))
 385
 386 (defun electric-describe-syntax ()
 387   (interactive)
 388   (electric-helpify 'describe-syntax))
 389
 390 (defun electric-command-apropos ()
 391   (interactive)
 392   (electric-helpify 'command-apropos "*Apropos*"))
 393
 394 ;(define-key help-map "a" 'electric-command-apropos)
 395
 396 (defun electric-apropos ()
 397   (interactive)
 398   (electric-helpify 'apropos))
 399
 400 \f
 401 ;;;; ehelp-map
 402
 403 (defvar ehelp-map
 404   (let ((map (copy-keymap help-map)))
 405     (substitute-key-definition 'apropos 'electric-apropos map)
 406     (substitute-key-definition 'command-apropos 'electric-command-apropos map)
 407     (substitute-key-definition 'describe-key 'electric-describe-key map)
 408     (substitute-key-definition 'describe-mode 'electric-describe-mode map)
 409     (substitute-key-definition 'view-lossage 'electric-view-lossage map)
 410     (substitute-key-definition 'describe-function 'electric-describe-function map)
 411     (substitute-key-definition 'describe-variable 'electric-describe-variable map)
 412     (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
 413     (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
 414     map))
 415
 416 ;;;###(autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap)
 417 (defalias 'ehelp-command ehelp-map)
 418 (put 'ehelp-command 'documentation "Prefix command for ehelp.")
 419
 420 (provide 'ehelp)
 421
 422 ;; arch-tag: e0e3037f-42c0-433e-ba18-322c5d951f46
 423 ;;; ehelp.el ends here