lisp/ehelp.el

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