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