lisp/ehelp.el

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