lisp/ehelp.el

   1 ;;; ehelp.el --- bindings for electric-help mode
   2
   3 ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Keywords: help, extensions
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  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 ;;; Code:
  33
  34 (require 'electric)
  35 (defvar electric-help-map ()
  36   "Keymap defining commands available in `electric-help-mode'.")
  37
  38 (put 'electric-help-undefined 'suppress-keymap t)
  39 (if electric-help-map
  40     ()
  41   (let ((map (make-keymap)))
  42     ;; allow all non-self-inserting keys - search, scroll, etc
  43     (suppress-keymap map)
  44     (define-key map (char-to-string help-char) 'electric-help-help)
  45     (define-key map "?" 'electric-help-help)
  46     (define-key map " " 'scroll-up)
  47     (define-key map "\^?" 'scroll-down)
  48     (define-key map "." 'beginning-of-buffer)
  49     (define-key map "<" 'beginning-of-buffer)
  50     (define-key map ">" 'end-of-buffer)
  51     ;(define-key map "\C-g" 'electric-help-exit)
  52     (define-key map "q" 'electric-help-exit)
  53     (define-key map "Q" 'electric-help-exit)
  54     ;;a better key than this?
  55     (define-key map "r" 'electric-help-retain)
  56     (define-key map "R" 'electric-help-retain)
  57
  58     (setq electric-help-map map)))
  59
  60 (defun electric-help-mode ()
  61   "`with-electric-help' temporarily places its buffer in this mode.
  62 \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
  63   (setq buffer-read-only t)
  64   (setq mode-name "Help")
  65   (setq major-mode 'help)
  66   (setq mode-line-buffer-identification '(" Help:  %b"))
  67   (use-local-map electric-help-map)
  68   ;; this is done below in with-electric-help
  69   ;(run-hooks 'electric-help-mode-hook)
  70   )
  71
  72 ;;;###autoload
  73 (defun with-electric-help (thunk &optional buffer noerase)
  74   "Arguments are THUNK &optional BUFFER NOERASE.  BUFFER defaults to `*Help*'.
  75 THUNK is a function of no arguments which is called to initialize
  76 the contents of BUFFER.  BUFFER will be erased before THUNK is called unless
  77 NOERASE is non-nil.  THUNK will be called with `standard-output' bound to
  78 the buffer specified by BUFFER
  79
  80 After THUNK has been called, this function \"electrically\" pops up a window
  81 in which BUFFER is displayed and allows the user to scroll through that buffer
  82 in electric-help-mode.
  83 When the user exits (with `electric-help-exit', or otherwise) the help
  84 buffer's window disappears (i.e., we use `save-window-excursion')
  85 BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
  86   (setq buffer (get-buffer-create (or buffer "*Help*")))
  87   (let ((one (one-window-p t))
  88         (config (current-window-configuration))
  89         (bury nil))
  90     (unwind-protect
  91          (save-excursion
  92            (if one (goto-char (window-start (selected-window))))
  93            (let ((pop-up-windows t))
  94              (pop-to-buffer buffer))
  95            (save-excursion
  96              (set-buffer buffer)
  97              (electric-help-mode)
  98              (setq buffer-read-only nil)
  99              (or noerase (erase-buffer)))
 100            (let ((standard-output buffer))
 101              (if (not (funcall thunk))
 102                  (progn
 103                    (set-buffer buffer)
 104                    (set-buffer-modified-p nil)
 105                    (goto-char (point-min))
 106                    (if one (shrink-window-if-larger-than-buffer (selected-window))))))
 107            (set-buffer buffer)
 108            (run-hooks 'electric-help-mode-hook)
 109            (if (eq (car-safe (electric-help-command-loop))
 110                    'retain)
 111                (setq config (current-window-configuration))
 112                (setq bury t)))
 113       (message "")
 114       (set-buffer buffer)
 115       (setq buffer-read-only nil)
 116       (condition-case ()
 117           (funcall (or default-major-mode 'fundamental-mode))
 118         (error nil))
 119       (set-window-configuration config)
 120       (if bury
 121           (progn
 122             ;;>> Perhaps this shouldn't be done.
 123             ;; so that when we say "Press space to bury" we mean it
 124             (replace-buffer-in-windows buffer)
 125             ;; must do this outside of save-window-excursion
 126             (bury-buffer buffer))))))
 127
 128 (defun electric-help-command-loop ()
 129   (catch 'exit
 130     (if (pos-visible-in-window-p (point-max))
 131         (progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
 132                (if (equal (setq unread-command-events (list (read-event)))
 133                           '(?\ ))
 134                    (progn (setq unread-command-events nil)
 135                           (throw 'exit t)))))
 136     (let (up down both neither
 137           (standard (and (eq (key-binding " ")
 138                              'scroll-up)
 139                          (eq (key-binding "\^?")
 140                              'scroll-down)
 141                          (eq (key-binding "q")
 142                              'electric-help-exit)
 143                          (eq (key-binding "r")
 144                              'electric-help-retain))))
 145       (Electric-command-loop
 146         'exit
 147         (function (lambda ()
 148           (let ((min (pos-visible-in-window-p (point-min)))
 149                 (max (pos-visible-in-window-p (point-max))))
 150             (cond ((and min max)
 151                    (cond (standard "Press q to exit, r to retain ")
 152                          (neither)
 153                          (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
 154                   (min
 155                    (cond (standard "Press SPC to scroll, q to exit, r to retain ")
 156                          (up)
 157                          (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
 158                   (max
 159                    (cond (standard "Press DEL to scroll back, q to exit ")
 160                          (down)
 161                          (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
 162                   (t
 163                    (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit ")
 164                          (both)
 165                          (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 ")))))))))
 166                     t))))
 167
 168
 169 \f
 170 ;(defun electric-help-scroll-up (arg)
 171 ;  ">>>Doc"
 172 ;  (interactive "P")
 173 ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
 174 ;      (electric-help-exit)
 175 ;    (scroll-up arg)))
 176
 177 (defun electric-help-exit ()
 178   ">>>Doc"
 179   (interactive)
 180   (throw 'exit t))
 181
 182 (defun electric-help-retain ()
 183   "Exit `electric-help', retaining the current window/buffer configuration.
 184 \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
 185 will select it.)"
 186   (interactive)
 187   (throw 'exit '(retain)))
 188
 189
 190 (defun electric-help-undefined ()
 191   (interactive)
 192   (error "%s is undefined -- Press %s to exit"
 193          (mapconcat 'single-key-description (this-command-keys) " ")
 194          (if (eq (key-binding "Q") 'electric-help-exit)
 195              "Q"
 196            (substitute-command-keys "\\[electric-help-exit]"))))
 197
 198
 199 ;>>> this needs to be hairified (recursive help, anybody?)
 200 (defun electric-help-help ()
 201   (interactive)
 202   (if (and (eq (key-binding "q") 'electric-help-exit)
 203            (eq (key-binding " ") 'scroll-up)
 204            (eq (key-binding "\^?") 'scroll-down)
 205            (eq (key-binding "r") 'electric-help-retain))
 206       (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
 207     (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
 208   (sit-for 2))
 209
 210 \f
 211 ;;;###autoload
 212 (defun electric-helpify (fun)
 213   (let ((name "*Help*"))
 214     (if (save-window-excursion
 215           ;; kludge-o-rama
 216           (let* ((p (symbol-function 'print-help-return-message))
 217                  (b (get-buffer name))
 218                  (m (buffer-modified-p b)))
 219             (and b (not (get-buffer-window b))
 220                  (setq b nil))
 221             (unwind-protect
 222                 (progn
 223                   (message "%s..." (capitalize (symbol-name fun)))
 224                   ;; with-output-to-temp-buffer marks the buffer as unmodified.
 225                   ;; kludging excessively and relying on that as some sort
 226                   ;;  of indication leads to the following abomination...
 227                   ;;>> This would be doable without such icky kludges if either
 228                   ;;>> (a) there were a function to read the interactive
 229                   ;;>>     args for a command and return a list of those args.
 230                   ;;>>     (To which one would then just apply the command)
 231                   ;;>>     (The only problem with this is that interactive-p
 232                   ;;>>      would break, but that is such a misfeature in
 233                   ;;>>      any case that I don't care)
 234                   ;;>>     It is easy to do this for emacs-lisp functions;
 235                   ;;>>     the only problem is getting the interactive spec
 236                   ;;>>     for subrs
 237                   ;;>> (b) there were a function which returned a
 238                   ;;>>     modification-tick for a buffer.  One could tell
 239                   ;;>>     whether a buffer had changed by whether the
 240                   ;;>>     modification-tick were different.
 241                   ;;>>     (Presumably there would have to be a way to either
 242                   ;;>>      restore the tick to some previous value, or to
 243                   ;;>>      suspend updating of the tick in order to allow
 244                   ;;>>      things like momentary-string-display)
 245                   (and b
 246                        (save-excursion
 247                          (set-buffer b)
 248                          (set-buffer-modified-p t)))
 249                   (fset 'print-help-return-message 'ignore)
 250                   (call-interactively fun)
 251                   (and (get-buffer name)
 252                        (get-buffer-window (get-buffer name))
 253                        (or (not b)
 254                            (not (eq b (get-buffer name)))
 255                            (not (buffer-modified-p b)))))
 256               (fset 'print-help-return-message p)
 257               (and b (buffer-name b)
 258                    (save-excursion
 259                      (set-buffer b)
 260                      (set-buffer-modified-p m))))))
 261         (with-electric-help 'ignore name t))))
 262
 263 \f
 264 (defun electric-describe-key ()
 265   (interactive)
 266   (electric-helpify 'describe-key))
 267
 268 (defun electric-describe-mode ()
 269   (interactive)
 270   (electric-helpify 'describe-mode))
 271
 272 (defun electric-view-lossage ()
 273   (interactive)
 274   (electric-helpify 'view-lossage))
 275
 276 ;(defun electric-help-for-help ()
 277 ;  "See help-for-help"
 278 ;  (interactive)
 279 ;  )
 280
 281 (defun electric-describe-function ()
 282   (interactive)
 283   (electric-helpify 'describe-function))
 284
 285 (defun electric-describe-variable ()
 286   (interactive)
 287   (electric-helpify 'describe-variable))
 288
 289 (defun electric-describe-bindings ()
 290   (interactive)
 291   (electric-helpify 'describe-bindings))
 292
 293 (defun electric-describe-syntax ()
 294   (interactive)
 295   (electric-helpify 'describe-syntax))
 296
 297 (defun electric-command-apropos ()
 298   (interactive)
 299   (electric-helpify 'command-apropos))
 300
 301 ;(define-key help-map "a" 'electric-command-apropos)
 302
 303 (defun electric-apropos ()
 304   (interactive)
 305   (electric-helpify 'apropos))
 306
 307 \f
 308 ;;;; ehelp-map
 309
 310 (defvar ehelp-map ())
 311 (if ehelp-map
 312     nil
 313   (let ((map (copy-keymap help-map)))
 314     (substitute-key-definition 'command-apropos 'electric-command-apropos map)
 315     (substitute-key-definition 'describe-key 'electric-describe-key map)
 316     (substitute-key-definition 'describe-mode 'electric-describe-mode map)
 317     (substitute-key-definition 'view-lossage 'electric-view-lossage map)
 318     (substitute-key-definition 'describe-function 'electric-describe-function map)
 319     (substitute-key-definition 'describe-variable 'electric-describe-variable map)
 320     (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
 321     (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
 322
 323     (setq ehelp-map map)
 324     (fset 'ehelp-command map)))
 325
 326 ;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
 327
 328 (provide 'ehelp)
 329
 330 ;;; ehelp.el ends here