Mercurial > hg > xemacs-beta

comparison lisp/help-macro.el @ 245:51092a27c943 r20-5b21

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b21
author cvs
date Mon, 13 Aug 2007 10:17:54 +0200
parents 262b8bb4a523
children
comparison
equal deleted inserted replaced
244:78d4f1140794 245:51092a27c943
74 A value of nil means skip the middle step, so that 74 A value of nil means skip the middle step, so that
75 \\[help-command] \\[help-command] gives the window that lists the options." 75 \\[help-command] \\[help-command] gives the window that lists the options."
76 :type 'boolean 76 :type 'boolean
77 :group 'help-appearance) 77 :group 'help-appearance)
78 78
79 ;;;###autoload
80 (defun help-read-key (prompt)
81 (let (events)
82 (while (not (key-press-event-p
83 (aref (setq events (read-key-sequence prompt)) 0)))
84 ;; Mouse clicks are not part of the help feature, so reexecute
85 ;; them in the standard environment.
86 (mapc 'dispatch-event events))
87 (let ((key (nconc (event-modifiers (aref events 0))
88 (list (event-key (aref events 0))))))
89 ;; Make the HELP key translate to C-h.
90 (when (lookup-key function-key-map key)
91 (setq key (lookup-key function-key-map key)))
92 (if (eq (length key) 1)
93 (car key)
94 key))))
95
96 (defmacro make-help-screen (fname help-line help-text helped-map) 79 (defmacro make-help-screen (fname help-line help-text helped-map)
97 "Construct help-menu function name FNAME. 80 "Construct help-menu function name FNAME.
98 When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP. 81 When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP.
99 If the command is the help character, FNAME displays HELP-TEXT 82 If the command is the help character, FNAME displays HELP-TEXT
100 and continues trying to read a command using HELPED-MAP. 83 and continues trying to read a command using HELPED-MAP.
101 When FNAME finally does get a command, it executes that command 84 When FNAME finally does get a command, it executes that command
102 and then returns." 85 and then returns."
103 `(defun ,fname () 86 `(defun ,fname ()
104 ,help-text 87 ,help-text
105 (interactive) 88 (interactive)
106 (let ((line-prompt 89 (flet ((help-read-key (prompt)
107 (substitute-command-keys ,help-line))) 90 ;; This is in `flet' to avoid problems with autoloading.
108 (when three-step-help 91 ;; #### The function is ill-conceived -- there should be
109 (message "%s" line-prompt)) 92 ;; a way to do it without all the hassle!
110 (let* ((help-screen (documentation (quote ,fname))) 93 (let (events)
111 ;; We bind overriding-local-map for very small 94 (while (not (key-press-event-p
112 ;; sections, *excluding* where we switch buffers 95 (aref (setq events (read-key-sequence prompt)) 0)))
113 ;; and where we execute the chosen help command. 96 ;; Mouse clicks are not part of the help feature, so
114 (local-map (make-sparse-keymap)) 97 ;; reexecute them in the standard environment.
115 (minor-mode-map-alist nil) 98 (mapc 'dispatch-event events))
116 (prev-frame (selected-frame)) 99 (let ((key (nconc (event-modifiers (aref events 0))
117 config new-frame key) 100 (list (event-key (aref events 0))))))
118 (unwind-protect 101 ;; Make the HELP key translate to C-h.
119 (progn 102 (when (lookup-key function-key-map key)
120 (set-keymap-parents local-map (list ,helped-map)) 103 (setq key (lookup-key function-key-map key)))
121 (cond (three-step-help 104 (if (eq (length key) 1)
122 (let* ((overriding-local-map local-map)) 105 (car key)
123 (setq key (help-read-key nil)))) 106 key)))))
124 (t 107 (let ((line-prompt
125 (setq key ??))) 108 (substitute-command-keys ,help-line)))
126 (when (or (equal key ??) 109 (when three-step-help
127 (equal key (list help-char))) 110 (message "%s" line-prompt))
128 (setq config (current-window-configuration)) 111 (let* ((help-screen (documentation (quote ,fname)))
129 (switch-to-buffer-other-window "*Help*") 112 ;; We bind overriding-local-map for very small
130 (and (not (eq (window-frame (selected-window)) 113 ;; sections, *excluding* where we switch buffers and
131 prev-frame)) 114 ;; where we execute the chosen help command.
132 (setq new-frame (window-frame (selected-window)) 115 (local-map (make-sparse-keymap))
133 config nil)) 116 (minor-mode-map-alist nil)
134 (setq buffer-read-only nil) 117 (prev-frame (selected-frame))
135 (erase-buffer) 118 config new-frame key)
136 (insert help-screen) 119 (unwind-protect
137 (help-mode) 120 (progn
138 (goto-char (point-min)) 121 (set-keymap-parents local-map (list ,helped-map))
139 (while (member key `((,help-char) ?? (control v) space ?\177 122 (cond (three-step-help
140 delete backspace (meta v))) 123 (let* ((overriding-local-map local-map))
141 (ignore-errors 124 (setq key (help-read-key nil))))
142 (cond ((member key '((control v) space))
143 (scroll-up))
144 ((member key '(?\177 delete (meta v) backspace))
145 (scroll-down))))
146 (let ((cursor-in-echo-area t)
147 (overriding-local-map local-map))
148 (setq key (help-read-key
149 (format "Type one of the options listed%s: "
150 (if (pos-visible-in-window-p
151 (point-max))
152 "" " or Space to scroll")))))))
153 ;; We don't need the prompt any more.
154 (message nil)
155 (let ((defn (lookup-key local-map key)))
156 (cond (defn
157 (when config
158 (set-window-configuration config)
159 (setq config nil))
160 (when new-frame
161 (iconify-frame new-frame)
162 (setq new-frame nil))
163 (call-interactively defn))
164 (t 125 (t
165 (ding))))) 126 (setq key ??)))
166 (and (get-buffer "*Help*") 127 (when (or (equal key ??)
167 (bury-buffer "*Help*")) 128 (equal key (list help-char)))
168 (and new-frame (iconify-frame new-frame)) 129 (setq config (current-window-configuration))
169 (and config 130 (switch-to-buffer-other-window "*Help*")
170 (set-window-configuration config))))))) 131 (and (not (eq (window-frame (selected-window))
132 prev-frame))
133 (setq new-frame (window-frame (selected-window))
134 config nil))
135 (setq buffer-read-only nil)
136 (erase-buffer)
137 (insert help-screen)
138 (help-mode)
139 (goto-char (point-min))
140 (while (member key `((,help-char) ?? (control v) space ?\177
141 delete backspace (meta v)))
142 (ignore-errors
143 (cond ((member key '((control v) space))
144 (scroll-up))
145 ((member key '(?\177 delete (meta v) backspace))
146 (scroll-down))))
147 (let ((cursor-in-echo-area t)
148 (overriding-local-map local-map))
149 (setq key (help-read-key
150 (format "Type one of the options listed%s: "
151 (if (pos-visible-in-window-p
152 (point-max))
153 "" " or Space to scroll")))))))
154 ;; We don't need the prompt any more.
155 (message nil)
156 (let ((defn (lookup-key local-map key)))
157 (cond (defn
158 (when config
159 (set-window-configuration config)
160 (setq config nil))
161 (when new-frame
162 (iconify-frame new-frame)
163 (setq new-frame nil))
164 (call-interactively defn))
165 (t
166 (ding)))))
167 (and (get-buffer "*Help*")
168 (bury-buffer "*Help*"))
169 (and new-frame (iconify-frame new-frame))
170 (and config
171 (set-window-configuration config))))))))
171 172
172 ;;; help-macro.el 173 ;;; help-macro.el
173 174