Mercurial > hg > xemacs-beta

comparison lisp/electric/ehelp.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; ehelp.el --- bindings for electric-help mode
2
3 ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
4
5 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
6
7 ;; Maintainer: FSF
8 ;; Keywords: help, extensions
9
10 ;; This file is part of XEmacs.
11
12 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; XEmacs is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25
26 ;;; Synched up with: FSF 19.30.
27
28 ;;; Commentary:
29
30 ;; This package provides a pre-packaged `Electric Help Mode' for
31 ;; browsing on-line help screens. There is one entry point,
32 ;; `with-electric-help'; all you have to give it is a no-argument
33 ;; function that generates the actual text of the help into the current
34 ;; buffer.
35
36 ;; To make this the default, you must do
37 ;; (require 'ehelp)
38 ;; (define-key global-map "\C-h" 'ehelp-command)
39 ;; (define-key global-map [help] 'ehelp-command)
40 ;; (define-key global-map [f1] 'ehelp-command)
41
42 ;;; Code:
43
44 (require 'electric)
45
46 (defvar electric-help-map nil
47 "Keymap defining commands available in `electric-help-mode'.")
48
49 (put 'electric-help-undefined 'suppress-keymap t)
50 (if electric-help-map
51 ()
52 (let ((map (make-keymap)))
53 (set-keymap-name map 'electric-help-map)
54 ;; allow all non-self-inserting keys - search, scroll, etc, but
55 ;; let M-x and C-x exit ehelp mode and retain buffer:
56 (suppress-keymap map)
57 (define-key map "\C-u" 'electric-help-undefined)
58 (define-key map [(control ?0)] 'electric-help-undefined)
59 (define-key map [(control ?1)] 'electric-help-undefined)
60 (define-key map [(control ?2)] 'electric-help-undefined)
61 (define-key map [(control ?3)] 'electric-help-undefined)
62 (define-key map [(control ?4)] 'electric-help-undefined)
63 (define-key map [(control ?5)] 'electric-help-undefined)
64 (define-key map [(control ?6)] 'electric-help-undefined)
65 (define-key map [(control ?7)] 'electric-help-undefined)
66 (define-key map [(control ?8)] 'electric-help-undefined)
67 (define-key map [(control ?9)] 'electric-help-undefined)
68 (define-key map (char-to-string help-char) 'electric-help-help)
69 (define-key map "?" 'electric-help-help)
70 (define-key map 'help 'electric-help-help)
71 (define-key map " " 'scroll-up)
72 (define-key map "\^?" 'scroll-down)
73 (define-key map "." 'beginning-of-buffer)
74 (define-key map "<" 'beginning-of-buffer)
75 (define-key map ">" 'end-of-buffer)
76 ;(define-key map "\C-g" 'electric-help-exit)
77 (define-key map "q" 'electric-help-exit)
78 (define-key map "Q" 'electric-help-exit)
79 ;;a better key than this?
80 (define-key map "r" 'electric-help-retain)
81 (define-key map "R" 'electric-help-retain)
82 (define-key map "\ex" 'electric-help-execute-extended)
83 (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
84
85 (setq electric-help-map map)))
86
87 (defun electric-help-mode ()
88 "`with-electric-help' temporarily places its buffer in this mode.
89 \(On exit from `with-electric-help', the buffer is put in `default-major-mode'.\)"
90 (setq buffer-read-only t)
91 (setq mode-name "Help")
92 (setq major-mode 'help)
93 (setq modeline-buffer-identification '(" Help: %b"))
94 (use-local-map electric-help-map)
95 (setq mouse-leave-buffer-hook '(electric-help-retain))
96 ;; this is done below in with-electric-help
97 ;(run-hooks 'electric-help-mode-hook)
98 )
99
100 ;;;###autoload
101 (defun with-electric-help (thunk &optional buffer noerase minheight)
102 "Pop up an \"electric\" help buffer.
103 The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT.
104 THUNK is a function of no arguments which is called to initialize the
105 contents of BUFFER. BUFFER defaults to `*Help*'. BUFFER will be
106 erased before THUNK is called unless NOERASE is non-nil. THUNK will
107 be called while BUFFER is current and with `standard-output' bound to
108 the buffer specified by BUFFER.
109
110 If THUNK returns nil, we display BUFFER starting at the top, and
111 shrink the window to fit. If THUNK returns non-nil, we don't do those things.
112
113 After THUNK has been called, this function \"electrically\" pops up a window
114 in which BUFFER is displayed and allows the user to scroll through that buffer
115 in electric-help-mode. The window's height will be at least MINHEIGHT if
116 this value is non-nil.
117
118 If THUNK returns nil, we display BUFFER starting at the top, and
119 shrink the window to fit. If THUNK returns non-nil, we don't do those
120 things.
121
122 When the user exits (with `electric-help-exit', or otherwise) the help
123 buffer's window disappears (i.e., we use `save-window-excursion')
124 BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
125 (setq buffer (get-buffer-create (or buffer "*Help*")))
126 (let ((one (one-window-p t))
127 (config (current-window-configuration))
128 (bury nil)
129 (to-be-executed nil))
130 (unwind-protect
131 (save-excursion
132 (if one (goto-char (window-start (selected-window))))
133 (let ((pop-up-windows t))
134 (pop-to-buffer buffer))
135 (save-excursion
136 (set-buffer buffer)
137 (if (and minheight (< (window-height) minheight))
138 (enlarge-window (- minheight (window-height))))
139 (electric-help-mode)
140 (setq buffer-read-only nil)
141 (or noerase (erase-buffer)))
142 (let ((standard-output buffer))
143 (if (not (funcall thunk))
144 (progn
145 (set-buffer buffer)
146 (set-buffer-modified-p nil)
147 (goto-char (point-min))
148 (if one (shrink-window-if-larger-than-buffer (selected-window))))))
149 (set-buffer buffer)
150 (run-hooks 'electric-help-mode-hook)
151 (if (eq (car-safe
152 ;; Don't be screwed by minor-modes (view-minor-mode)
153 (let ((overriding-local-map electric-help-map))
154 (electric-help-command-loop)))
155 'retain)
156 (setq config (current-window-configuration))
157 (setq bury t)))
158 (message nil)
159 (set-buffer buffer)
160 (setq buffer-read-only nil)
161 (condition-case ()
162 (funcall (or default-major-mode 'fundamental-mode))
163 (error nil))
164 (set-window-configuration config)
165 (if bury
166 (progn
167 ;;>> Perhaps this shouldn't be done.
168 ;; so that when we say "Press space to bury" we mean it
169 (replace-buffer-in-windows buffer)
170 ;; must do this outside of save-window-excursion
171 (bury-buffer buffer)))
172 (eval to-be-executed))))
173
174 (defun electric-help-command-loop ()
175 (catch 'exit
176 (if (pos-visible-in-window-p (point-max))
177 (progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
178 (if (equal (setq unread-command-events
179 (list (next-command-event)))
180 '(?\ ))
181 (progn (setq unread-command-events nil)
182 (throw 'exit t)))))
183 (let (up down both neither
184 (standard (and (eq (key-binding " ")
185 'scroll-up)
186 (eq (key-binding "\^?")
187 'scroll-down)
188 (eq (key-binding "q")
189 'electric-help-exit)
190 (eq (key-binding "r")
191 'electric-help-retain))))
192 (Electric-command-loop
193 'exit
194 (function (lambda ()
195 (sit-for 0) ;necessary if last command was end-of-buffer or
196 ;beginning-of-buffer - otherwise pos-visible-in-window-p
197 ;will yield a wrong result.
198 (let ((min (pos-visible-in-window-p (point-min)))
199 (max (pos-visible-in-window-p (point-max))))
200 (cond (isearch-mode 'noprompt)
201 ((and min max)
202 (cond (standard "Press q to exit, r to retain ")
203 (neither)
204 (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
205 (min
206 (cond (standard "Press SPC to scroll, q to exit, r to retain ")
207 (up)
208 (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
209 (max
210 (cond (standard "Press DEL to scroll back, q to exit, r to retain ")
211 (down)
212 (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
213 (t
214 (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
215 (both)
216 (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 ")))))))))
217 t))))
218
219
220
221 ;(defun electric-help-scroll-up (arg)
222 ; "####Doc"
223 ; (interactive "P")
224 ; (if (and (null arg) (pos-visible-in-window-p (point-max)))
225 ; (electric-help-exit)
226 ; (scroll-up arg)))
227
228 (defun electric-help-exit ()
229 "####Doc"
230 (interactive)
231 (throw 'exit t))
232
233 (defun electric-help-retain ()
234 "Exit `electric-help', retaining the current window/buffer configuration.
235 \(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
236 will select it.)"
237 (interactive)
238 ;; Make sure that we don't throw twice, even if two events cause
239 ;; calling this function:
240 (if mouse-leave-buffer-hook
241 (progn
242 (setq mouse-leave-buffer-hook nil)
243 (throw 'exit '(retain)))))
244
245
246 ;(defun electric-help-undefined ()
247 ; (interactive)
248 ; (let* ((keys (this-command-keys))
249 ; (n (length keys)))
250 ; (if (or (= n 1)
251 ; (and (= n 2)
252 ; meta-flag
253 ; (eq (aref keys 0) meta-prefix-char)))
254 ; (setq unread-command-char last-input-char
255 ; current-prefix-arg prefix-arg)
256 ; ;;#### I don't care.
257 ; ;;#### The emacs command-loop is too much pure pain to
258 ; ;;#### duplicate
259 ; ))
260 ; (throw 'exit t))
261
262 (defun electric-help-undefined ()
263 (interactive)
264 (error "%s is undefined -- Press %s to exit"
265 (mapconcat 'single-key-description (this-command-keys) " ")
266 (if (eq (key-binding "q") 'electric-help-exit)
267 "q"
268 (substitute-command-keys "\\[electric-help-exit]"))))
269
270
271 ;#### this needs to be hairified (recursive help, anybody?)
272 (defun electric-help-help ()
273 (interactive)
274 (if (and (eq (key-binding "q") 'electric-help-exit)
275 (eq (key-binding " ") 'scroll-up)
276 (eq (key-binding "\^?") 'scroll-down)
277 (eq (key-binding "r") 'electric-help-retain))
278 (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
279 (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
280 (sit-for 2))
281
282
283 ;;;###autoload
284 (defun electric-helpify (fun &optional buffer-name)
285 (or buffer-name (setq buffer-name "*Help*"))
286 (let* ((p (symbol-function 'print-help-return-message))
287 (b (get-buffer buffer-name))
288 (tick (and b (buffer-modified-tick b))))
289 (and b (not (get-buffer-window b))
290 (setq b nil))
291 (if (unwind-protect
292 (save-window-excursion
293 (message "%s..." (capitalize (symbol-name fun)))
294 ;; kludge-o-rama
295 (fset 'print-help-return-message 'ignore)
296 (let ((a (call-interactively fun 'lambda)))
297 (let ((temp-buffer-show-function 'ignore))
298 (apply fun a)))
299 (message nil)
300 ;; Was a non-empty help buffer created/modified?
301 (let ((r (get-buffer buffer-name)))
302 (and r
303 ;(get-buffer-window r)
304 (or (not b)
305 (not (eq b r))
306 (not (eql tick (buffer-modified-tick b))))
307 (save-excursion
308 (set-buffer r)
309 (> (buffer-size) 0)))))
310 (fset 'print-help-return-message p)
311 )
312 (with-electric-help 'ignore buffer-name t))))
313
314
315
316 ;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then
317 ;; continues with execute-extended-command.
318 (defun electric-help-execute-extended (prefixarg)
319 (interactive "p")
320 (setq to-be-executed '(execute-extended-command nil))
321 (electric-help-retain))
322
323 ;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
324 ;; continues with ctrl-x prefix.
325 (defun electric-help-ctrl-x-prefix (prefixarg)
326 (interactive "p")
327 (setq to-be-executed '(progn (message nil) (setq unread-command-char ?\C-x)))
328 (electric-help-retain))
329
330
331 (defun electric-describe-key ()
332 (interactive)
333 (electric-helpify 'describe-key))
334
335 (defun electric-describe-mode ()
336 (interactive)
337 (electric-helpify 'describe-mode))
338
339 (defun electric-view-lossage ()
340 (interactive)
341 (electric-helpify 'view-lossage))
342
343 ;(defun electric-help-for-help ()
344 ; "See help-for-help"
345 ; (interactive)
346 ; )
347
348 (defun electric-describe-function ()
349 (interactive)
350 (electric-helpify 'describe-function))
351
352 (defun electric-describe-variable ()
353 (interactive)
354 (electric-helpify 'describe-variable))
355
356 (defun electric-describe-bindings ()
357 (interactive)
358 (electric-helpify 'describe-bindings))
359
360 (defun electric-describe-syntax ()
361 (interactive)
362 (electric-helpify 'describe-syntax))
363
364 (defun electric-command-apropos ()
365 (interactive)
366 (electric-helpify 'command-apropos))
367
368 ;(define-key help-map "a" 'electric-command-apropos)
369
370 (defun electric-apropos ()
371 (interactive)
372 (electric-helpify 'apropos))
373
374
375
376 ;;;; ehelp-map
377
378 (defvar ehelp-map nil)
379 (if ehelp-map
380 nil
381 ;; #### WTF? Why don't we just use substitute-key-definition
382 ;; like FSF does?
383 (let ((shadow '((apropos . electric-apropos)
384 (command-apropos . electric-command-apropos)
385 (describe-key . electric-describe-key)
386 (describe-mode . electric-describe-mode)
387 (view-lossage . electric-view-lossage)
388 (describe-function . electric-describe-function)
389 (describe-variable . electric-describe-variable)
390 (describe-bindings . electric-describe-bindings)
391 (describe-syntax . electric-describe-syntax)))
392 (map (make-sparse-keymap)))
393 (set-keymap-name map 'ehelp-map)
394 (set-keymap-parents map (list help-map))
395 ;; Shadow bindings which would be inherited from help-map
396 ;;#### This doesn't descend into sub-keymaps
397 (map-keymap (function (lambda (key binding)
398 (let ((tem (assq binding shadow)))
399 (if tem
400 (define-key map key (cdr tem))))))
401 help-map)
402 (setq ehelp-map map)
403 (fset 'ehelp-command map)))
404
405 ;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
406
407 (provide 'ehelp)
408
409 ;;; ehelp.el ends here