|
428
|
1 ;;; hyper-apropos.el --- Hypertext emacs lisp documentation interface.
|
|
|
2
|
|
502
|
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
|
|
428
|
4 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
|
|
|
5 ;; Copyright (C) 1995 Sun Microsystems.
|
|
1275
|
6 ;; Copyright (C) 1996, 2003 Ben Wing.
|
|
428
|
7
|
|
502
|
8 ;; Author: Jonathan Stigelman <stig@xemacs.org>
|
|
|
9 ;; Maintainer: XEmacs Development Team
|
|
428
|
10 ;; Keywords: lisp, tools, help, docs, matching
|
|
|
11
|
|
|
12 ;; This file is part of XEmacs.
|
|
|
13
|
|
|
14 ;; XEmacs is free software; you can redistribute it and/or modify
|
|
|
15 ;; it under the terms of the GNU General Public License as published by
|
|
|
16 ;; the Free Software Foundation; either version 2 of the License, or
|
|
|
17 ;; (at your option) any later version.
|
|
|
18 ;;
|
|
|
19 ;; XEmacs is distributed in the hope that it will be useful,
|
|
|
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
22 ;; GNU General Public License for more details.
|
|
|
23 ;;
|
|
|
24 ;; You should have received a copy of the GNU General Public License
|
|
|
25 ;; along with XEmacs; if not, write to the Free Software
|
|
|
26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
27
|
|
|
28 ;;; Synched up with: Not in FSF.
|
|
|
29
|
|
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;; based upon emacs-apropos.el by Frank C. Guida <fcg@philabs.philips.com>
|
|
|
33 ;;
|
|
|
34 ;; Rather than run apropos and print all the documentation at once,
|
|
|
35 ;; I find it easier to view a "table of contents" first, then
|
|
|
36 ;; get the details for symbols as you need them.
|
|
|
37 ;;
|
|
|
38 ;; This version of apropos prints two lists of symbols matching the
|
|
|
39 ;; given regexp: functions/macros and variables/constants.
|
|
|
40 ;;
|
|
|
41 ;; The user can then do the following:
|
|
|
42 ;;
|
|
|
43 ;; - add an additional regexp to narrow the search
|
|
|
44 ;; - display documentation for the current symbol
|
|
|
45 ;; - find the tag for the current symbol
|
|
|
46 ;; - show any keybindings if the current symbol is a command
|
|
|
47 ;; - invoke functions
|
|
|
48 ;; - set variables
|
|
|
49 ;;
|
|
|
50 ;; An additional feature is the ability to search the current tags
|
|
|
51 ;; table, allowing you to interrogate functions not yet loaded (this
|
|
|
52 ;; isn't available with the standard package).
|
|
|
53 ;;
|
|
|
54 ;; Mouse bindings and menus are provided for XEmacs.
|
|
|
55 ;;
|
|
|
56 ;; additions by Ben Wing <ben@xemacs.org> July 1995:
|
|
|
57 ;; added support for function aliases, made programmer's apropos be the
|
|
|
58 ;; default, various other hacking.
|
|
|
59 ;; Massive changes by Christoph Wedler <wedler@fmi.uni-passau.de>
|
|
|
60 ;; Some changes for XEmacs 20.3 by hniksic
|
|
|
61
|
|
440
|
62 ;; #### The maintainer is supposed to be stig, but I haven't seen him
|
|
428
|
63 ;; around for ages. The real maintainer for the moment is Hrvoje
|
|
|
64 ;; Niksic <hniksic@xemacs.org>.
|
|
|
65
|
|
|
66 ;;; Code:
|
|
|
67
|
|
|
68 (defgroup hyper-apropos nil
|
|
|
69 "Hypertext emacs lisp documentation interface."
|
|
|
70 :group 'docs
|
|
|
71 :group 'lisp
|
|
|
72 :group 'tools
|
|
|
73 :group 'help
|
|
|
74 :group 'matching)
|
|
|
75
|
|
|
76 (defcustom hyper-apropos-show-brief-docs t
|
|
|
77 "*If non-nil, display some documentation in the \"*Hyper Apropos*\" buffer.
|
|
|
78 Setting this to nil will speed up searches."
|
|
|
79 :type 'boolean
|
|
|
80 :group 'hyper-apropos)
|
|
|
81 (define-obsolete-variable-alias
|
|
|
82 'hypropos-show-brief-docs 'hyper-apropos-show-brief-docs)
|
|
502
|
83
|
|
|
84 ;; I changed the following to true because it's obviously more useful
|
|
|
85 ;; that way, and is a very good example of following the principle of
|
|
|
86 ;; least surprise. --ben
|
|
428
|
87
|
|
|
88 (defcustom hyper-apropos-programming-apropos t
|
|
|
89 "*If non-nil, list all the functions and variables.
|
|
|
90 This will cause more output to be generated, and take a longer time.
|
|
502
|
91 Otherwise, only the interactive functions and user variables will be listed.
|
|
428
|
92
|
|
502
|
93 If you're thinking of setting it to nil, consider that you can get the
|
|
|
94 equivalent just by using the command \\[command-hyper-apropos]. (And if you do set it to nil,
|
|
|
95 you can get the full output by using \\[universal-argument] \\[hyper-apropos].)"
|
|
428
|
96 :type 'boolean
|
|
|
97 :group 'hyper-apropos)
|
|
|
98 (define-obsolete-variable-alias
|
|
|
99 'hypropos-programming-apropos 'hyper-apropos-programming-apropos)
|
|
|
100
|
|
|
101 (defcustom hyper-apropos-shrink-window nil
|
|
|
102 "*If non-nil, shrink *Hyper Help* buffer if possible."
|
|
|
103 :type 'boolean
|
|
|
104 :group 'hyper-apropos)
|
|
|
105 (define-obsolete-variable-alias
|
|
|
106 'hypropos-shrink-window 'hyper-apropos-shrink-window)
|
|
|
107
|
|
|
108 (defcustom hyper-apropos-prettyprint-long-values t
|
|
|
109 "*If non-nil, then try to beautify the printing of very long values."
|
|
|
110 :type 'boolean
|
|
|
111 :group 'hyper-apropos)
|
|
|
112 (define-obsolete-variable-alias
|
|
|
113 'hypropos-prettyprint-long-values 'hyper-apropos-prettyprint-long-values)
|
|
|
114
|
|
|
115 (defgroup hyper-apropos-faces nil
|
|
|
116 "Faces defined by hyper-apropos."
|
|
|
117 :prefix "hyper-apropos-"
|
|
|
118 :group 'faces)
|
|
|
119
|
|
|
120 (defface hyper-apropos-documentation
|
|
|
121 '((((class color) (background light))
|
|
|
122 (:foreground "darkred"))
|
|
|
123 (((class color) (background dark))
|
|
|
124 (:foreground "gray90")))
|
|
|
125 "Hyper-apropos documentation."
|
|
|
126 :group 'hyper-apropos-faces)
|
|
|
127
|
|
|
128 (defface hyper-apropos-hyperlink
|
|
|
129 '((((class color) (background light))
|
|
|
130 (:foreground "blue4"))
|
|
|
131 (((class color) (background dark))
|
|
|
132 (:foreground "lightseagreen"))
|
|
|
133 (t
|
|
|
134 (:bold t)))
|
|
|
135 "Hyper-apropos hyperlinks."
|
|
|
136 :group 'hyper-apropos-faces)
|
|
|
137
|
|
|
138 (defface hyper-apropos-major-heading '((t (:bold t)))
|
|
|
139 "Hyper-apropos major heading."
|
|
|
140 :group 'hyper-apropos-faces)
|
|
|
141
|
|
|
142 (defface hyper-apropos-section-heading '((t (:bold t :italic t)))
|
|
|
143 "Hyper-apropos section heading."
|
|
|
144 :group 'hyper-apropos-faces)
|
|
|
145
|
|
|
146 (defface hyper-apropos-heading '((t (:bold t)))
|
|
|
147 "Hyper-apropos heading."
|
|
|
148 :group 'hyper-apropos-faces)
|
|
|
149
|
|
|
150 (defface hyper-apropos-warning '((t (:bold t :foreground "red")))
|
|
|
151 "Hyper-apropos warning."
|
|
|
152 :group 'hyper-apropos-faces)
|
|
|
153
|
|
|
154 ;;; Internal variables below this point
|
|
|
155
|
|
|
156 (defvar hyper-apropos-ref-buffer)
|
|
|
157 (defvar hyper-apropos-prev-wconfig)
|
|
|
158
|
|
|
159 (defvar hyper-apropos-help-map
|
|
|
160 (let ((map (make-sparse-keymap)))
|
|
|
161 (suppress-keymap map)
|
|
|
162 (set-keymap-name map 'hyper-apropos-help-map)
|
|
|
163 ;; movement
|
|
|
164 (define-key map " " 'scroll-up)
|
|
|
165 (define-key map "b" 'scroll-down)
|
|
|
166 (define-key map [delete] 'scroll-down)
|
|
|
167 (define-key map [backspace] 'scroll-down)
|
|
|
168 (define-key map "/" 'isearch-forward)
|
|
|
169 (define-key map "?" 'isearch-backward)
|
|
|
170 ;; follow links
|
|
|
171 (define-key map [return] 'hyper-apropos-get-doc)
|
|
|
172 (define-key map "s" 'hyper-apropos-set-variable)
|
|
|
173 (define-key map "t" 'hyper-apropos-find-tag)
|
|
|
174 (define-key map "l" 'hyper-apropos-last-help)
|
|
|
175 (define-key map "c" 'hyper-apropos-customize-variable)
|
|
|
176 (define-key map "f" 'hyper-apropos-find-function)
|
|
718
|
177 (define-key map "v" 'hyper-apropos-find-variable)
|
|
428
|
178 (define-key map [button2] 'hyper-apropos-mouse-get-doc)
|
|
|
179 (define-key map [button3] 'hyper-apropos-popup-menu)
|
|
|
180 ;; for the totally hardcore...
|
|
|
181 (define-key map "D" 'hyper-apropos-disassemble)
|
|
|
182 ;; administrativa
|
|
|
183 (define-key map "a" 'hyper-apropos)
|
|
|
184 (define-key map "n" 'hyper-apropos)
|
|
|
185 (define-key map "q" 'hyper-apropos-quit)
|
|
|
186 map)
|
|
|
187 "Keybindings for the *Hyper Help* buffer and the *Hyper Apropos* buffer")
|
|
|
188 (define-obsolete-variable-alias
|
|
|
189 'hypropos-help-map 'hyper-apropos-help-map)
|
|
|
190
|
|
|
191 (defvar hyper-apropos-map
|
|
|
192 (let ((map (make-sparse-keymap)))
|
|
|
193 (set-keymap-name map 'hyper-apropos-map)
|
|
|
194 (set-keymap-parents map (list hyper-apropos-help-map))
|
|
|
195 ;; slightly different scrolling...
|
|
|
196 (define-key map " " 'hyper-apropos-scroll-up)
|
|
|
197 (define-key map "b" 'hyper-apropos-scroll-down)
|
|
|
198 (define-key map [delete] 'hyper-apropos-scroll-down)
|
|
|
199 (define-key map [backspace] 'hyper-apropos-scroll-down)
|
|
|
200 ;; act on the current line...
|
|
|
201 (define-key map "w" 'hyper-apropos-where-is)
|
|
|
202 (define-key map "i" 'hyper-apropos-invoke-fn)
|
|
|
203 ;; this is already defined in the parent-keymap above, isn't it?
|
|
|
204 ;; (define-key map "s" 'hyper-apropos-set-variable)
|
|
|
205 ;; more administrativa...
|
|
|
206 (define-key map "P" 'hyper-apropos-toggle-programming-flag)
|
|
|
207 (define-key map "k" 'hyper-apropos-add-keyword)
|
|
|
208 (define-key map "e" 'hyper-apropos-eliminate-keyword)
|
|
|
209 map)
|
|
|
210 "Keybindings for the *Hyper Apropos* buffer.
|
|
|
211 This map inherits from `hyper-apropos-help-map.'")
|
|
|
212 (define-obsolete-variable-alias
|
|
|
213 'hypropos-map 'hyper-apropos-map)
|
|
|
214
|
|
|
215 ;;(defvar hyper-apropos-mousable-keymap
|
|
|
216 ;; (let ((map (make-sparse-keymap)))
|
|
|
217 ;; (define-key map [button2] 'hyper-apropos-mouse-get-doc)
|
|
|
218 ;; map))
|
|
|
219
|
|
|
220 (defvar hyper-apropos-mode-hook nil
|
|
|
221 "*User function run after hyper-apropos mode initialization. Usage:
|
|
|
222 \(add-hook 'hyper-apropos-mode-hook #'(lambda () ... your init forms ...)).")
|
|
|
223
|
|
|
224 ;; ---------------------------------------------------------------------- ;;
|
|
|
225
|
|
|
226 (defconst hyper-apropos-junk-regexp
|
|
|
227 "^Apropos\\|^Functions\\|^Variables\\|^$")
|
|
|
228
|
|
|
229 (defvar hyper-apropos-currently-showing nil) ; symbol documented in
|
|
|
230 ; help buffer now
|
|
|
231 (defvar hyper-apropos-help-history nil) ; chain of symbols followed as links in
|
|
|
232 ; help buffer
|
|
|
233 (defvar hyper-apropos-face-history nil)
|
|
|
234 ;;;(defvar hyper-apropos-variable-history nil)
|
|
|
235 ;;;(defvar hyper-apropos-function-history nil)
|
|
|
236 (defvar hyper-apropos-regexp-history nil)
|
|
|
237 (defvar hyper-apropos-last-regexp nil) ; regex used for last apropos
|
|
|
238 (defconst hyper-apropos-apropos-buf "*Hyper Apropos*")
|
|
|
239 (defconst hyper-apropos-help-buf "*Hyper Help*")
|
|
|
240
|
|
|
241 ;;;###autoload
|
|
502
|
242 (defun command-hyper-apropos (regexp)
|
|
|
243 "Display lists of commands and user options matching REGEXP
|
|
|
244 in buffer \"*Hyper Apropos*\". See `hyper-apropos-mode' for a
|
|
|
245 description of the available commands in a Hyper-Apropos buffer."
|
|
|
246 (interactive (list (read-from-minibuffer
|
|
|
247 "List symbols matching regexp: "
|
|
|
248 nil nil nil 'hyper-apropos-regexp-history)))
|
|
|
249 (let ((hyper-apropos-programming-apropos nil))
|
|
|
250 (hyper-apropos regexp nil)))
|
|
|
251
|
|
|
252 ;;;###autoload
|
|
428
|
253 (defun hyper-apropos (regexp toggle-apropos)
|
|
|
254 "Display lists of functions and variables matching REGEXP
|
|
|
255 in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the
|
|
|
256 value of `hyper-apropos-programming-apropos' is toggled for this search.
|
|
502
|
257 See `hyper-apropos-mode' for a description of the available commands in
|
|
|
258 a Hyper-Apropos buffer."
|
|
|
259 (interactive (list (read-from-minibuffer
|
|
|
260 "List symbols matching regexp: "
|
|
|
261 nil nil nil 'hyper-apropos-regexp-history)
|
|
428
|
262 current-prefix-arg))
|
|
|
263 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
|
|
|
264 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
|
|
|
265 (if (string= "" regexp)
|
|
|
266 (if (get-buffer hyper-apropos-apropos-buf)
|
|
434
|
267 (progn
|
|
|
268 (setq regexp hyper-apropos-last-regexp)
|
|
|
269 (if toggle-apropos
|
|
|
270 (hyper-apropos-toggle-programming-flag)
|
|
|
271 (message "Using last search results")))
|
|
428
|
272 (error "Be more specific..."))
|
|
|
273 (set-buffer (get-buffer-create hyper-apropos-apropos-buf))
|
|
|
274 (setq buffer-read-only nil)
|
|
|
275 (erase-buffer)
|
|
|
276 (if toggle-apropos
|
|
434
|
277 (if (local-variable-p 'hyper-apropos-programming-apropos
|
|
|
278 (current-buffer))
|
|
|
279 (setq hyper-apropos-programming-apropos
|
|
|
280 (not hyper-apropos-programming-apropos))
|
|
|
281 (set (make-local-variable 'hyper-apropos-programming-apropos)
|
|
|
282 (not (default-value 'hyper-apropos-programming-apropos)))))
|
|
428
|
283 (let ((flist (apropos-internal regexp
|
|
|
284 (if hyper-apropos-programming-apropos
|
|
|
285 #'fboundp
|
|
|
286 #'commandp)))
|
|
|
287 (vlist (apropos-internal regexp
|
|
|
288 (if hyper-apropos-programming-apropos
|
|
|
289 #'boundp
|
|
|
290 #'user-variable-p))))
|
|
|
291 (insert-face (format "Apropos search for: %S\n\n" regexp)
|
|
|
292 'hyper-apropos-major-heading)
|
|
|
293 (insert-face "* = command (M-x) or user-variable.\n"
|
|
|
294 'hyper-apropos-documentation)
|
|
|
295 (insert-face "\
|
|
|
296 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.\n\n"
|
|
|
297 'hyper-apropos-documentation)
|
|
|
298 (insert-face "Functions and Macros:\n\n" 'hyper-apropos-major-heading)
|
|
1275
|
299 (hyper-apropos-grok-functions flist nil)
|
|
|
300 (insert-face "\n\nObsolete Functions and Macros:\n\n" 'hyper-apropos-major-heading)
|
|
|
301 (hyper-apropos-grok-functions flist t)
|
|
428
|
302 (insert-face "\n\nVariables and Constants:\n\n"
|
|
|
303 'hyper-apropos-major-heading)
|
|
1275
|
304 (hyper-apropos-grok-variables vlist nil)
|
|
|
305 (insert-face "\n\nObsolete Variables and Constants:\n\n"
|
|
|
306 'hyper-apropos-major-heading)
|
|
|
307 (hyper-apropos-grok-variables vlist t)
|
|
428
|
308 (goto-char (point-min))))
|
|
|
309 (switch-to-buffer hyper-apropos-apropos-buf)
|
|
|
310 (hyper-apropos-mode regexp))
|
|
|
311
|
|
|
312 (defun hyper-apropos-toggle-programming-flag ()
|
|
|
313 (interactive)
|
|
|
314 (with-current-buffer hyper-apropos-apropos-buf
|
|
|
315 (set (make-local-variable 'hyper-apropos-programming-apropos)
|
|
|
316 (not hyper-apropos-programming-apropos)))
|
|
|
317 (message "Re-running apropos...")
|
|
|
318 (hyper-apropos hyper-apropos-last-regexp nil))
|
|
|
319
|
|
1275
|
320 (defun hyper-apropos-grok-functions (fns obsolete-p)
|
|
|
321 (loop for fn in fns
|
|
|
322 if (eq (function-obsolete-p fn) obsolete-p) do
|
|
|
323 (let* ((bind (symbol-function fn))
|
|
|
324 (type (cond ((subrp bind) ?i)
|
|
428
|
325 ((compiled-function-p bind) ?b)
|
|
|
326 ((consp bind) (or (cdr
|
|
|
327 (assq (car bind) '((autoload . ?a)
|
|
|
328 (lambda . ?l)
|
|
|
329 (macro . ?m))))
|
|
|
330 ??))
|
|
1275
|
331 (t ?\ ))))
|
|
428
|
332 (insert type (if (commandp fn) "* " " "))
|
|
|
333 (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink)))
|
|
|
334 (set-extent-property e 'mouse-face 'highlight))
|
|
|
335 (insert-char ?\ (let ((l (- 30 (length (format "%S" fn)))))
|
|
|
336 (if (natnump l) l 0)))
|
|
|
337 (and hyper-apropos-show-brief-docs
|
|
1275
|
338 (let ((doc
|
|
|
339 (if (and obsolete-p
|
|
|
340 (symbolp fn)
|
|
|
341 (symbolp (symbol-function fn)))
|
|
|
342 (function-obsoleteness-doc fn)
|
|
|
343 ;; A symbol's function slot can point to an unbound symbol.
|
|
|
344 ;; In that case, `documentation' will fail.
|
|
2275
|
345 (condition-case nil
|
|
|
346 (documentation fn)
|
|
|
347 (void-function "(alias for undefined function)")
|
|
|
348 (error "(unexpected error from `documention')")))))
|
|
1275
|
349 (if (and
|
|
|
350 doc
|
|
|
351 (string-match
|
|
|
352 "\\`([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
|
|
|
353 doc))
|
|
|
354 (setq doc (substring doc (match-end 0)
|
|
|
355 (string-match "\n" doc))))
|
|
|
356 ;; Skip errant newlines at beginning of doc
|
|
|
357 (if (and doc
|
|
|
358 (string-match "\\`\n+" doc))
|
|
|
359 (setq doc (substring doc (match-end 0))))
|
|
|
360 (insert-face (if doc
|
|
|
361 (concat " - "
|
|
|
362 (substring doc 0
|
|
|
363 (string-match "\n" doc)))
|
|
|
364 " - Not documented.")
|
|
|
365 'hyper-apropos-documentation)))
|
|
428
|
366 (insert ?\n))))
|
|
|
367
|
|
1275
|
368 (defun hyper-apropos-grok-variables (vars obsolete-p)
|
|
|
369 (loop for var in vars
|
|
|
370 if (eq (variable-obsolete-p var) obsolete-p) do
|
|
|
371 (let ((userp (user-variable-p var)))
|
|
428
|
372 (insert (if userp " * " " "))
|
|
|
373 (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink)))
|
|
|
374 (set-extent-property e 'mouse-face 'highlight))
|
|
|
375 (insert-char ?\ (let ((l (- 30 (length (format "%S" var)))))
|
|
|
376 (if (natnump l) l 0)))
|
|
|
377 (and hyper-apropos-show-brief-docs
|
|
1275
|
378 (let ((doc
|
|
|
379 (if (and obsolete-p (variable-alias var))
|
|
|
380 (variable-obsoleteness-doc var)
|
|
|
381 (documentation-property var 'variable-documentation))))
|
|
|
382 ;; Skip errant newlines at beginning of doc
|
|
|
383 (if (and doc
|
|
|
384 (string-match "\\`\n+" doc))
|
|
|
385 (setq doc (substring doc (match-end 0))))
|
|
|
386 (insert-face (if doc
|
|
|
387 (concat " - " (substring
|
|
|
388 doc (if userp 1 0)
|
|
|
389 (string-match "\n" doc)))
|
|
|
390 " - Not documented.")
|
|
|
391 'hyper-apropos-documentation)))
|
|
428
|
392 (insert ?\n))))
|
|
|
393
|
|
|
394 ;; ---------------------------------------------------------------------- ;;
|
|
|
395
|
|
|
396 (defun hyper-apropos-mode (regexp)
|
|
|
397 "Improved apropos mode for displaying Emacs documentation. Function and
|
|
|
398 variable names are displayed in the buffer \"*Hyper Apropos*\".
|
|
|
399
|
|
|
400 Functions are preceded by a single character to indicates their types:
|
|
|
401 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.
|
|
|
402 Interactive functions are also preceded by an asterisk.
|
|
|
403 Variables are preceded by an asterisk if they are user variables.
|
|
|
404
|
|
|
405 General Commands:
|
|
|
406
|
|
|
407 SPC - scroll documentation or apropos window forward
|
|
|
408 b - scroll documentation or apropos window backward
|
|
|
409 k - eliminate all hits that don't contain keyword
|
|
|
410 n - new search
|
|
|
411 / - isearch-forward
|
|
|
412 q - quit and restore previous window configuration
|
|
|
413
|
|
|
414 Operations for Symbol on Current Line:
|
|
|
415
|
|
|
416 RET - toggle display of symbol's documentation
|
|
|
417 (also on button2 in xemacs)
|
|
|
418 w - show the keybinding if symbol is a command
|
|
|
419 i - invoke function on current line
|
|
|
420 s - set value of variable on current line
|
|
|
421 t - display the C or lisp source (find-tag)"
|
|
|
422 (delete-other-windows)
|
|
|
423 (setq mode-name "Hyper-Apropos"
|
|
|
424 major-mode 'hyper-apropos-mode
|
|
|
425 buffer-read-only t
|
|
|
426 truncate-lines t
|
|
|
427 hyper-apropos-last-regexp regexp
|
|
|
428 modeline-buffer-identification
|
|
|
429 (list (cons modeline-buffer-id-left-extent "Hyper Apropos: ")
|
|
|
430 (cons modeline-buffer-id-right-extent (concat "\"" regexp "\""))))
|
|
|
431 (use-local-map hyper-apropos-map)
|
|
|
432 (run-hooks 'hyper-apropos-mode-hook))
|
|
|
433
|
|
|
434 ;; ---------------------------------------------------------------------- ;;
|
|
|
435
|
|
|
436 ;; similar to `describe-key-briefly', copied from help.el by CW
|
|
|
437
|
|
|
438 ;;;###autoload
|
|
|
439 (defun hyper-describe-key (key)
|
|
|
440 (interactive "kDescribe key: ")
|
|
|
441 (hyper-describe-key-briefly key t))
|
|
|
442
|
|
|
443 ;;;###autoload
|
|
|
444 (defun hyper-describe-key-briefly (key &optional show)
|
|
|
445 (interactive "kDescribe key briefly: \nP")
|
|
|
446 (let (menup defn interm final msg)
|
|
|
447 (setq defn (key-or-menu-binding key 'menup))
|
|
|
448 (if (or (null defn) (integerp defn))
|
|
|
449 (or (numberp show) (message "%s is undefined" (key-description key)))
|
|
|
450 (cond ((stringp defn)
|
|
|
451 (setq interm defn
|
|
|
452 final (key-binding defn)))
|
|
|
453 ((vectorp defn)
|
|
|
454 (setq interm (append defn nil))
|
|
|
455 (while (and interm
|
|
|
456 (member (key-binding (vector (car interm)))
|
|
|
457 '(universal-argument digit-argument)))
|
|
|
458 (setq interm (cdr interm)))
|
|
|
459 (while (and interm
|
|
|
460 (not (setq final (key-binding (vconcat interm)))))
|
|
|
461 (setq interm (butlast interm)))
|
|
|
462 (if final
|
|
|
463 (setq interm (vconcat interm))
|
|
|
464 (setq interm defn
|
|
|
465 final (key-binding defn)))))
|
|
|
466 (setq msg (format
|
|
|
467 "%s runs %s%s%s"
|
|
|
468 ;; This used to say 'This menu item' but it could also
|
|
|
469 ;; be a scrollbar event. We can't distinguish at the
|
|
|
470 ;; moment.
|
|
|
471 (if menup "This item" (key-description key))
|
|
|
472 ;;(if (symbolp defn) defn (key-description defn))
|
|
|
473 (if (symbolp defn) defn (prin1-to-string defn))
|
|
|
474 (if final (concat ", " (key-description interm) " runs ") "")
|
|
|
475 (if final
|
|
|
476 (if (symbolp final) final (prin1-to-string final))
|
|
|
477 "")))
|
|
|
478 (if (numberp show)
|
|
|
479 (or (not (symbolp defn))
|
|
|
480 (memq (symbol-function defn)
|
|
|
481 '(zkey-init-kbd-macro zkey-init-kbd-fn))
|
|
|
482 (progn (princ msg) (princ "\n")))
|
|
|
483 (message "%s" msg)
|
|
|
484 (if final (setq defn final))
|
|
|
485 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn))))
|
|
|
486 defn
|
|
|
487 show)
|
|
438
|
488 (hyper-apropos-get-doc defn t))
|
|
|
489 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
|
|
|
490 (setq hyper-apropos-prev-wconfig (current-window-configuration)))))))
|
|
428
|
491
|
|
|
492 ;;;###autoload
|
|
|
493 (defun hyper-describe-face (symbol &optional this-ref-buffer)
|
|
|
494 "Describe face..
|
|
|
495 See also `hyper-apropos' and `hyper-describe-function'."
|
|
|
496 ;; #### - perhaps a prefix arg should suppress the prompt...
|
|
|
497 (interactive
|
|
|
498 (let (v val)
|
|
|
499 (setq v (hyper-apropos-this-symbol)) ; symbol under point
|
|
|
500 (or (find-face v)
|
|
|
501 (setq v (variable-at-point)))
|
|
|
502 (setq val (let ((enable-recursive-minibuffers t))
|
|
|
503 (completing-read
|
|
|
504 (concat (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
|
|
|
505 "Follow face"
|
|
|
506 "Describe face")
|
|
|
507 (if v
|
|
|
508 (format " (default %s): " v)
|
|
|
509 ": "))
|
|
|
510 (mapcar #'(lambda (x) (list (symbol-name x)))
|
|
|
511 (face-list))
|
|
438
|
512 nil t nil 'hyper-apropos-face-history
|
|
|
513 (and v (symbol-name v)))))
|
|
|
514 (list (intern-soft val)
|
|
428
|
515 current-prefix-arg)))
|
|
|
516 (if (null symbol)
|
|
|
517 (message "Sorry, nothing to describe.")
|
|
|
518 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
|
|
|
519 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
|
|
|
520 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
|
|
|
521
|
|
|
522 ;;;###autoload
|
|
|
523 (defun hyper-describe-variable (symbol &optional this-ref-buffer)
|
|
|
524 "Hypertext drop-in replacement for `describe-variable'.
|
|
|
525 See also `hyper-apropos' and `hyper-describe-function'."
|
|
|
526 ;; #### - perhaps a prefix arg should suppress the prompt...
|
|
|
527 (interactive (list (hyper-apropos-read-variable-symbol
|
|
|
528 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
|
|
|
529 "Follow variable"
|
|
|
530 "Describe variable"))
|
|
|
531 current-prefix-arg))
|
|
|
532 (if (null symbol)
|
|
|
533 (message "Sorry, nothing to describe.")
|
|
|
534 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
|
|
|
535 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
|
|
|
536 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
|
|
|
537
|
|
|
538 ;;;###autoload
|
|
|
539 (defun hyper-where-is (symbol)
|
|
|
540 "Print message listing key sequences that invoke specified command."
|
|
|
541 (interactive (list (hyper-apropos-read-function-symbol "Where is function")))
|
|
|
542 (if (null symbol)
|
|
|
543 (message "Sorry, nothing to describe.")
|
|
|
544 (where-is symbol)))
|
|
|
545
|
|
|
546 ;;;###autoload
|
|
|
547 (defun hyper-describe-function (symbol &optional this-ref-buffer)
|
|
|
548 "Hypertext replacement for `describe-function'. Unlike `describe-function'
|
|
|
549 in that the symbol under the cursor is the default if it is a function.
|
|
|
550 See also `hyper-apropos' and `hyper-describe-variable'."
|
|
|
551 ;; #### - perhaps a prefix arg should suppress the prompt...
|
|
|
552 (interactive (list (hyper-apropos-read-function-symbol
|
|
|
553 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
|
|
|
554 "Follow function"
|
|
|
555 "Describe function"))
|
|
|
556 current-prefix-arg))
|
|
|
557 (if (null symbol)
|
|
|
558 (message "Sorry, nothing to describe.")
|
|
|
559 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
|
|
|
560 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
|
|
|
561 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
|
|
|
562
|
|
|
563 ;;;###autoload
|
|
|
564 (defun hyper-apropos-read-variable-symbol (prompt &optional predicate)
|
|
|
565 "Hypertext drop-in replacement for `describe-variable'.
|
|
|
566 See also `hyper-apropos' and `hyper-describe-function'."
|
|
|
567 ;; #### - perhaps a prefix arg should suppress the prompt...
|
|
|
568 (or predicate (setq predicate 'boundp))
|
|
|
569 (let (v val)
|
|
|
570 (setq v (hyper-apropos-this-symbol)) ; symbol under point
|
|
|
571 (or (funcall predicate v)
|
|
|
572 (setq v (variable-at-point)))
|
|
|
573 (or (funcall predicate v)
|
|
|
574 (setq v nil))
|
|
|
575 (setq val (let ((enable-recursive-minibuffers t))
|
|
|
576 (completing-read
|
|
|
577 (concat prompt
|
|
|
578 (if v
|
|
|
579 (format " (default %s): " v)
|
|
|
580 ": "))
|
|
438
|
581 obarray predicate t nil 'variable-history
|
|
|
582 (and v (symbol-name v)))))
|
|
|
583 (intern-soft val)))
|
|
|
584
|
|
428
|
585 ;;;###autoload
|
|
|
586 (define-obsolete-function-alias
|
|
|
587 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol)
|
|
|
588
|
|
|
589 (defun hyper-apropos-read-function-symbol (prompt)
|
|
|
590 "Read function symbol from minibuffer."
|
|
|
591 (let ((fn (hyper-apropos-this-symbol))
|
|
|
592 val)
|
|
|
593 (or (fboundp fn)
|
|
|
594 (setq fn (function-at-point)))
|
|
|
595 (setq val (let ((enable-recursive-minibuffers t))
|
|
|
596 (completing-read (if fn
|
|
|
597 (format "%s (default %s): " prompt fn)
|
|
|
598 (format "%s: " prompt))
|
|
|
599 obarray 'fboundp t nil
|
|
438
|
600 'function-history
|
|
|
601 (and fn (symbol-name fn)))))
|
|
|
602 (intern-soft val)))
|
|
428
|
603
|
|
|
604 (defun hyper-apropos-last-help (arg)
|
|
|
605 "Go back to the last symbol documented in the *Hyper Help* buffer."
|
|
|
606 (interactive "P")
|
|
|
607 (let ((win (get-buffer-window hyper-apropos-help-buf)))
|
|
|
608 (or arg (setq arg (if win 1 0)))
|
|
|
609 (cond ((= arg 0))
|
|
|
610 ((<= (length hyper-apropos-help-history) arg)
|
|
|
611 ;; go back as far as we can...
|
|
|
612 (setcdr (nreverse hyper-apropos-help-history) nil))
|
|
|
613 (t
|
|
|
614 (setq hyper-apropos-help-history
|
|
|
615 (nthcdr arg hyper-apropos-help-history))))
|
|
|
616 (if (or win (> arg 0))
|
|
|
617 (hyper-apropos-get-doc (car hyper-apropos-help-history) t)
|
|
|
618 (display-buffer hyper-apropos-help-buf))))
|
|
|
619
|
|
|
620 (defun hyper-apropos-insert-face (string &optional face)
|
|
|
621 "Insert STRING and fontify some parts with face `hyper-apropos-hyperlink'."
|
|
|
622 (let ((beg (point)) end)
|
|
|
623 (insert-face string (or face 'hyper-apropos-documentation))
|
|
|
624 (setq end (point))
|
|
|
625 (goto-char beg)
|
|
|
626 (while (re-search-forward
|
|
|
627 "`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'"
|
|
|
628 end 'limit)
|
|
|
629 (let ((e (make-extent (match-beginning 1) (match-end 1))))
|
|
|
630 (set-extent-face e 'hyper-apropos-hyperlink)
|
|
|
631 (set-extent-property e 'mouse-face 'highlight)))
|
|
|
632 (goto-char beg)
|
|
|
633 (while (re-search-forward
|
|
|
634 "M-x \\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)"
|
|
|
635 end 'limit)
|
|
|
636 (let ((e (make-extent (match-beginning 1) (match-end 1))))
|
|
|
637 (set-extent-face e 'hyper-apropos-hyperlink)
|
|
|
638 (set-extent-property e 'mouse-face 'highlight)))))
|
|
|
639
|
|
|
640 (defun hyper-apropos-insert-keybinding (keys string)
|
|
|
641 (if keys
|
|
|
642 (insert " (" string " bound to \""
|
|
|
643 (mapconcat 'key-description
|
|
|
644 (sort* keys #'< :key #'length)
|
|
|
645 "\", \"")
|
|
|
646 "\")\n")))
|
|
|
647
|
|
|
648 (defun hyper-apropos-insert-section-heading (alias-desc &optional desc)
|
|
|
649 (or desc (setq desc alias-desc
|
|
|
650 alias-desc nil))
|
|
|
651 (if alias-desc
|
|
|
652 (setq desc (concat alias-desc
|
|
|
653 (if (memq (aref desc 0)
|
|
|
654 '(?a ?e ?i ?o ?u))
|
|
|
655 ", an " ", a ")
|
|
|
656 desc)))
|
|
|
657 (aset desc 0 (upcase (aref desc 0))) ; capitalize
|
|
|
658 (goto-char (point-max))
|
|
|
659 (newline 3) (delete-blank-lines) (newline 2)
|
|
|
660 (hyper-apropos-insert-face desc 'hyper-apropos-section-heading))
|
|
|
661
|
|
|
662 (defun hyper-apropos-insert-value (string symbol val)
|
|
|
663 (insert-face string 'hyper-apropos-heading)
|
|
|
664 (insert (if (symbol-value symbol)
|
|
|
665 (if (or (null val) (eq val t) (integerp val))
|
|
|
666 (prog1
|
|
|
667 (symbol-value symbol)
|
|
|
668 (set symbol nil))
|
|
|
669 "see below")
|
|
|
670 "is void")))
|
|
|
671
|
|
|
672 (defun hyper-apropos-follow-ref-buffer (this-ref-buffer)
|
|
|
673 (and (not this-ref-buffer)
|
|
|
674 (eq major-mode 'hyper-apropos-help-mode)
|
|
|
675 hyper-apropos-ref-buffer
|
|
|
676 (buffer-live-p hyper-apropos-ref-buffer)))
|
|
|
677
|
|
|
678 (defun hyper-apropos-get-alias (symbol alias-p next-symbol &optional use)
|
|
|
679 "Return (TERMINAL-SYMBOL . ALIAS-DESC)."
|
|
|
680 (let (aliases)
|
|
|
681 (while (funcall alias-p symbol)
|
|
|
682 (setq aliases (cons (if use (funcall use symbol) symbol) aliases))
|
|
|
683 (setq symbol (funcall next-symbol symbol)))
|
|
|
684 (cons symbol
|
|
|
685 (and aliases
|
|
|
686 (concat "an alias for `"
|
|
|
687 (mapconcat 'symbol-name
|
|
|
688 (nreverse aliases)
|
|
|
689 "',\nwhich is an alias for `")
|
|
|
690 "'")))))
|
|
|
691
|
|
|
692 (defun hyper-apropos-get-doc (&optional symbol force type this-ref-buffer)
|
|
|
693 ;; #### - update this docstring
|
|
|
694 "Toggle display of documentation for the symbol on the current line."
|
|
|
695 ;; SYMBOL is the symbol to document. FORCE, if non-nil, means to
|
|
|
696 ;; regenerate the documentation even if it already seems to be there. And
|
|
|
697 ;; TYPE, if present, forces the generation of only variable documentation
|
|
|
698 ;; or only function documentation. Normally, if both are present, then
|
|
|
699 ;; both will be generated.
|
|
|
700 ;;
|
|
|
701 ;; TYPES TO IMPLEMENT: obsolete face
|
|
|
702 ;;
|
|
|
703 (interactive)
|
|
|
704 (or symbol
|
|
|
705 (setq symbol (hyper-apropos-this-symbol)))
|
|
|
706 (or type
|
|
|
707 (setq type '(function variable face)))
|
|
|
708 (if (and (eq hyper-apropos-currently-showing symbol)
|
|
|
709 (get-buffer hyper-apropos-help-buf)
|
|
|
710 (get-buffer-window hyper-apropos-help-buf)
|
|
|
711 (not force))
|
|
|
712 ;; we're already displaying this help, so toggle its display.
|
|
|
713 (delete-windows-on hyper-apropos-help-buf)
|
|
|
714 ;; OK, we've got to refresh and display it...
|
|
|
715 (or (eq symbol (car hyper-apropos-help-history))
|
|
|
716 (setq hyper-apropos-help-history
|
|
|
717 (if (eq major-mode 'hyper-apropos-help-mode)
|
|
|
718 ;; if we're following a link in the help buffer, then
|
|
|
719 ;; record that in the help history.
|
|
|
720 (cons symbol hyper-apropos-help-history)
|
|
|
721 ;; otherwise clear the history because it's a new search.
|
|
|
722 (list symbol))))
|
|
|
723 (save-excursion
|
|
|
724 (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
|
|
|
725 (set-buffer hyper-apropos-ref-buffer)
|
|
|
726 (setq hyper-apropos-ref-buffer (current-buffer)))
|
|
|
727 (let (standard-output
|
|
|
728 ok beg
|
|
|
729 newsym symtype doc obsolete
|
|
|
730 (local mode-name)
|
|
|
731 global local-str global-str
|
|
|
732 font fore back undl
|
|
|
733 aliases alias-desc desc)
|
|
|
734 (save-excursion
|
|
|
735 (set-buffer (get-buffer-create hyper-apropos-help-buf))
|
|
|
736 ;;(setq standard-output (current-buffer))
|
|
|
737 (setq buffer-read-only nil)
|
|
|
738 (erase-buffer)
|
|
|
739 (insert-face (format "`%s'" symbol) 'hyper-apropos-major-heading)
|
|
|
740 (insert (format " (buffer: %s, mode: %s)\n"
|
|
|
741 (buffer-name hyper-apropos-ref-buffer)
|
|
|
742 local)))
|
|
|
743 ;; function ----------------------------------------------------------
|
|
|
744 (and (memq 'function type)
|
|
|
745 (fboundp symbol)
|
|
|
746 (progn
|
|
|
747 (setq ok t)
|
|
|
748 (setq aliases (hyper-apropos-get-alias (symbol-function symbol)
|
|
|
749 'symbolp
|
|
|
750 'symbol-function)
|
|
|
751 newsym (car aliases)
|
|
|
752 alias-desc (cdr aliases))
|
|
|
753 (if (eq 'macro (car-safe newsym))
|
|
|
754 (setq desc "macro"
|
|
|
755 newsym (cdr newsym))
|
|
|
756 (setq desc "function"))
|
|
|
757 (setq symtype (cond ((subrp newsym) 'subr)
|
|
|
758 ((compiled-function-p newsym) 'bytecode)
|
|
|
759 ((eq (car-safe newsym) 'autoload) 'autoload)
|
|
|
760 ((eq (car-safe newsym) 'lambda) 'lambda))
|
|
|
761 desc (concat (if (commandp symbol) "interactive ")
|
|
|
762 (cdr (assq symtype
|
|
|
763 '((subr . "built-in ")
|
|
|
764 (bytecode . "compiled Lisp ")
|
|
|
765 (autoload . "autoloaded Lisp ")
|
|
|
766 (lambda . "Lisp "))))
|
|
|
767 desc
|
|
|
768 (case symtype
|
|
|
769 ((autoload) (format ",\n(autoloaded from \"%s\")"
|
|
|
770 (nth 1 newsym)))
|
|
|
771 ((bytecode) (format ",\n(loaded from \"%s\")"
|
|
|
772 (symbol-file symbol)))))
|
|
|
773 local (current-local-map)
|
|
|
774 global (current-global-map)
|
|
|
775 obsolete (get symbol 'byte-obsolete-info)
|
|
2275
|
776 doc (or (condition-case nil
|
|
|
777 (documentation symbol)
|
|
|
778 (void-function
|
|
|
779 "(alias for undefined function)")
|
|
|
780 (error "(unexpected error from `documention')"))
|
|
|
781 "function not documented"))
|
|
428
|
782 (save-excursion
|
|
|
783 (set-buffer hyper-apropos-help-buf)
|
|
|
784 (goto-char (point-max))
|
|
|
785 (setq standard-output (current-buffer))
|
|
|
786 (hyper-apropos-insert-section-heading alias-desc desc)
|
|
|
787 (insert ":\n")
|
|
|
788 (if local
|
|
|
789 (hyper-apropos-insert-keybinding
|
|
|
790 (where-is-internal symbol (list local) nil nil nil)
|
|
|
791 "locally"))
|
|
|
792 (hyper-apropos-insert-keybinding
|
|
|
793 (where-is-internal symbol (list global) nil nil nil)
|
|
|
794 "globally")
|
|
|
795 (insert "\n")
|
|
|
796 (if obsolete
|
|
|
797 (hyper-apropos-insert-face
|
|
|
798 (format "%s is an obsolete function; %s\n\n" symbol
|
|
|
799 (if (stringp (car obsolete))
|
|
|
800 (car obsolete)
|
|
|
801 (format "use `%s' instead." (car obsolete))))
|
|
|
802 'hyper-apropos-warning))
|
|
|
803 (setq beg (point))
|
|
|
804 (insert-face "arguments: " 'hyper-apropos-heading)
|
|
|
805 (cond ((eq symtype 'lambda)
|
|
|
806 (princ (or (nth 1 newsym) "()")))
|
|
|
807 ((eq symtype 'bytecode)
|
|
|
808 (princ (or (compiled-function-arglist newsym)
|
|
|
809 "()")))
|
|
|
810 ((and (eq symtype 'subr)
|
|
|
811 (string-match
|
|
|
812 "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'"
|
|
|
813 doc))
|
|
|
814 (insert (substring doc
|
|
|
815 (match-beginning 1)
|
|
|
816 (match-end 1)))
|
|
|
817 (setq doc (substring doc 0 (match-beginning 0))))
|
|
|
818 ((and (eq symtype 'subr)
|
|
|
819 (string-match
|
|
|
820 "\
|
|
|
821 \[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
|
|
|
822 doc))
|
|
|
823 (insert "("
|
|
|
824 (if (match-end 1)
|
|
|
825 (substring doc
|
|
|
826 (match-beginning 1)
|
|
|
827 (match-end 1)))
|
|
|
828 ")")
|
|
|
829 (setq doc (substring doc (match-end 0))))
|
|
|
830 (t (princ "[not available]")))
|
|
|
831 (insert "\n\n")
|
|
|
832 (hyper-apropos-insert-face doc)
|
|
|
833 (insert "\n")
|
|
|
834 (indent-rigidly beg (point) 2))))
|
|
|
835 ;; variable ----------------------------------------------------------
|
|
|
836 (and (memq 'variable type)
|
|
|
837 (or (boundp symbol) (default-boundp symbol))
|
|
|
838 (progn
|
|
|
839 (setq ok t)
|
|
|
840 (setq aliases (hyper-apropos-get-alias symbol
|
|
|
841 'variable-alias
|
|
|
842 'variable-alias
|
|
|
843 'variable-alias)
|
|
|
844 newsym (car aliases)
|
|
|
845 alias-desc (cdr aliases))
|
|
|
846 (setq symtype (or (local-variable-p newsym (current-buffer))
|
|
|
847 (and (local-variable-p newsym
|
|
|
848 (current-buffer) t)
|
|
|
849 'auto-local))
|
|
|
850 desc (concat (and (get newsym 'custom-type)
|
|
|
851 "customizable ")
|
|
|
852 (if (user-variable-p newsym)
|
|
|
853 "user variable"
|
|
|
854 "variable")
|
|
|
855 (cond ((eq symtype t) ", buffer-local")
|
|
|
856 ((eq symtype 'auto-local)
|
|
|
857 ", local when set")))
|
|
|
858 local (and (boundp newsym)
|
|
|
859 (symbol-value newsym))
|
|
|
860 local-str (and (boundp newsym)
|
|
|
861 (prin1-to-string local))
|
|
|
862 global (and (eq symtype t)
|
|
|
863 (default-boundp newsym)
|
|
|
864 (default-value newsym))
|
|
|
865 global-str (and (eq symtype t)
|
|
|
866 (default-boundp newsym)
|
|
|
867 (prin1-to-string global))
|
|
|
868 obsolete (get symbol 'byte-obsolete-variable)
|
|
|
869 doc (or (documentation-property symbol
|
|
|
870 'variable-documentation)
|
|
|
871 "variable not documented"))
|
|
|
872 (save-excursion
|
|
|
873 (set-buffer hyper-apropos-help-buf)
|
|
|
874 (goto-char (point-max))
|
|
|
875 (setq standard-output (current-buffer))
|
|
|
876 (hyper-apropos-insert-section-heading alias-desc desc)
|
|
|
877 (when (and (user-variable-p newsym)
|
|
|
878 (get newsym 'custom-type))
|
|
|
879 (let ((e (make-extent (point-at-bol) (point))))
|
|
|
880 (set-extent-property e 'mouse-face 'highlight)
|
|
|
881 (set-extent-property e 'help-echo
|
|
|
882 (format "Customize %s" newsym))
|
|
|
883 (set-extent-property
|
|
|
884 e 'hyper-apropos-custom
|
|
|
885 `(lambda () (customize-variable (quote ,newsym))))))
|
|
|
886 (insert ":\n\n")
|
|
|
887 (setq beg (point))
|
|
|
888 (if obsolete
|
|
|
889 (hyper-apropos-insert-face
|
|
|
890 (format "%s is an obsolete function; %s\n\n" symbol
|
|
|
891 (if (stringp obsolete)
|
|
|
892 obsolete
|
|
|
893 (format "use `%s' instead." obsolete)))
|
|
|
894 'hyper-apropos-warning))
|
|
|
895 ;; generally, the value of the variable is short and the
|
|
|
896 ;; documentation of the variable long, so it's desirable
|
|
|
897 ;; to see all of the value and the start of the
|
|
|
898 ;; documentation. Some variables, though, have huge and
|
|
|
899 ;; nearly meaningless values that force you to page
|
|
|
900 ;; forward just to find the doc string. That is
|
|
|
901 ;; undesirable.
|
|
|
902 (if (and (or (null local-str) (< (length local-str) 69))
|
|
|
903 (or (null global-str) (< (length global-str) 69)))
|
|
|
904 ; 80 cols. docstrings assume this.
|
|
|
905 (progn (insert-face "value: " 'hyper-apropos-heading)
|
|
|
906 (insert (or local-str "is void"))
|
|
|
907 (if (eq symtype t)
|
|
|
908 (progn
|
|
|
909 (insert "\n")
|
|
|
910 (insert-face "default value: " 'hyper-apropos-heading)
|
|
|
911 (insert (or global-str "is void"))))
|
|
|
912 (insert "\n\n")
|
|
|
913 (hyper-apropos-insert-face doc))
|
|
|
914 (hyper-apropos-insert-value "value: " 'local-str local)
|
|
|
915 (if (eq symtype t)
|
|
|
916 (progn
|
|
|
917 (insert ", ")
|
|
|
918 (hyper-apropos-insert-value "default-value: "
|
|
|
919 'global-str global)))
|
|
|
920 (insert "\n\n")
|
|
|
921 (hyper-apropos-insert-face doc)
|
|
|
922 (if local-str
|
|
|
923 (progn
|
|
|
924 (newline 3) (delete-blank-lines) (newline 1)
|
|
|
925 (insert-face "value: " 'hyper-apropos-heading)
|
|
|
926 (if hyper-apropos-prettyprint-long-values
|
|
|
927 (condition-case nil
|
|
|
928 (cl-prettyprint local)
|
|
|
929 (error (insert local-str)))
|
|
|
930 (insert local-str))))
|
|
|
931 (if global-str
|
|
|
932 (progn
|
|
|
933 (newline 3) (delete-blank-lines) (newline 1)
|
|
|
934 (insert-face "default value: " 'hyper-apropos-heading)
|
|
|
935 (if hyper-apropos-prettyprint-long-values
|
|
|
936 (condition-case nil
|
|
|
937 (cl-prettyprint global)
|
|
|
938 (error (insert global-str)))
|
|
|
939 (insert global-str)))))
|
|
|
940 (indent-rigidly beg (point) 2))))
|
|
|
941 ;; face --------------------------------------------------------------
|
|
|
942 (and (memq 'face type)
|
|
|
943 (find-face symbol)
|
|
|
944 (progn
|
|
|
945 (setq ok t)
|
|
|
946 (copy-face symbol 'hyper-apropos-temp-face 'global)
|
|
|
947 (mapcar #'(lambda (property)
|
|
|
948 (setq symtype (face-property-instance symbol
|
|
|
949 property))
|
|
|
950 (if symtype
|
|
|
951 (set-face-property 'hyper-apropos-temp-face
|
|
|
952 property
|
|
|
953 symtype)))
|
|
|
954 built-in-face-specifiers)
|
|
|
955 (setq font (cons (face-property-instance symbol 'font nil 0 t)
|
|
|
956 (face-property-instance symbol 'font))
|
|
|
957 fore (cons (face-foreground-instance symbol nil 0 t)
|
|
|
958 (face-foreground-instance symbol))
|
|
|
959 back (cons (face-background-instance symbol nil 0 t)
|
|
|
960 (face-background-instance symbol))
|
|
|
961 undl (cons (face-underline-p symbol nil 0 t)
|
|
|
962 (face-underline-p symbol))
|
|
|
963 doc (face-doc-string symbol))
|
|
|
964 ;; #### - add some code here
|
|
|
965 (save-excursion
|
|
|
966 (set-buffer hyper-apropos-help-buf)
|
|
|
967 (setq standard-output (current-buffer))
|
|
|
968 (hyper-apropos-insert-section-heading
|
|
|
969 (concat "Face"
|
|
|
970 (when (get symbol 'face-defface-spec)
|
|
|
971 (let* ((str " (customizable)")
|
|
|
972 (e (make-extent 1 (length str) str)))
|
|
|
973 (set-extent-property e 'mouse-face 'highlight)
|
|
|
974 (set-extent-property e 'help-echo
|
|
|
975 (format "Customize %s" symbol))
|
|
|
976 (set-extent-property e 'unique t)
|
|
|
977 (set-extent-property e 'duplicable t)
|
|
|
978 (set-extent-property
|
|
|
979 e 'hyper-apropos-custom
|
|
|
980 `(lambda () (customize-face (quote ,symbol))))
|
|
|
981 str))
|
|
|
982 ":\n\n "))
|
|
|
983 (insert-face "\
|
|
|
984 ABCDEFHIJKLMNOPQRSTUVWXYZ abcdefhijklmnopqrstuvwxyz 0123456789"
|
|
|
985 'hyper-apropos-temp-face)
|
|
|
986 (newline 2)
|
|
|
987 (insert-face " Font: " 'hyper-apropos-heading)
|
|
|
988 (insert (format (if (numberp (car font)) "(%s)\n" "%s\n")
|
|
|
989 (and (cdr font)
|
|
|
990 (font-instance-name (cdr font)))))
|
|
|
991 (insert-face " Foreground: " 'hyper-apropos-heading)
|
|
|
992 (insert (format (if (numberp (car fore)) "(%s)\n" "%s\n")
|
|
|
993 (and (cdr fore)
|
|
|
994 (color-instance-name (cdr fore)))))
|
|
|
995 (insert-face " Background: " 'hyper-apropos-heading)
|
|
|
996 (insert (format (if (numberp (car back)) "(%s)\n" "%s\n")
|
|
|
997 (and (cdr back)
|
|
|
998 (color-instance-name (cdr back)))))
|
|
|
999 (insert-face " Underline: " 'hyper-apropos-heading)
|
|
|
1000 (insert (format (if (numberp (car undl)) "(%s)\n" "%s\n")
|
|
|
1001 (cdr undl)))
|
|
|
1002 (if doc
|
|
|
1003 (progn
|
|
|
1004 (newline)
|
|
|
1005 (setq beg (point))
|
|
|
1006 (insert doc)
|
|
|
1007 (indent-rigidly beg (point) 2))))))
|
|
|
1008 ;; not bound & property list -----------------------------------------
|
|
|
1009 (or ok
|
|
|
1010 (save-excursion
|
|
|
1011 (set-buffer hyper-apropos-help-buf)
|
|
|
1012 (hyper-apropos-insert-section-heading
|
|
|
1013 "symbol is not currently bound\n")))
|
|
|
1014 (if (and (setq symtype (symbol-plist symbol))
|
|
|
1015 (or (> (length symtype) 2)
|
|
|
1016 (not (memq 'variable-documentation symtype))))
|
|
|
1017 (save-excursion
|
|
|
1018 (set-buffer hyper-apropos-help-buf)
|
|
|
1019 (goto-char (point-max))
|
|
|
1020 (setq standard-output (current-buffer))
|
|
|
1021 (hyper-apropos-insert-section-heading "property-list:\n\n")
|
|
|
1022 (while symtype
|
|
|
1023 (if (memq (car symtype)
|
|
|
1024 '(variable-documentation byte-obsolete-info))
|
|
|
1025 (setq symtype (cdr symtype))
|
|
|
1026 (insert-face (concat " " (symbol-name (car symtype))
|
|
|
1027 ": ")
|
|
|
1028 'hyper-apropos-heading)
|
|
|
1029 (setq symtype (cdr symtype))
|
|
|
1030 (indent-to 32)
|
|
|
1031 (insert (prin1-to-string (car symtype)) "\n"))
|
|
|
1032 (setq symtype (cdr symtype)))))))
|
|
|
1033 (save-excursion
|
|
|
1034 (set-buffer hyper-apropos-help-buf)
|
|
|
1035 (goto-char (point-min))
|
|
|
1036 ;; pop up window and shrink it if it's wasting space
|
|
|
1037 (if hyper-apropos-shrink-window
|
|
|
1038 (shrink-window-if-larger-than-buffer
|
|
|
1039 (display-buffer (current-buffer)))
|
|
|
1040 (display-buffer (current-buffer)))
|
|
|
1041 (hyper-apropos-help-mode))
|
|
|
1042 (setq hyper-apropos-currently-showing symbol)))
|
|
|
1043 ;;;###autoload
|
|
|
1044 (define-obsolete-function-alias
|
|
|
1045 'hypropos-get-doc 'hyper-apropos-get-doc)
|
|
|
1046
|
|
|
1047 ; -----------------------------------------------------------------------------
|
|
|
1048
|
|
|
1049 (defun hyper-apropos-help-mode ()
|
|
|
1050 "Major mode for hypertext XEmacs help. In this mode, you can quickly
|
|
|
1051 follow links between back and forth between the documentation strings for
|
|
|
1052 different variables and functions. Common commands:
|
|
|
1053
|
|
|
1054 \\{hyper-apropos-help-map}"
|
|
|
1055 (setq buffer-read-only t
|
|
|
1056 major-mode 'hyper-apropos-help-mode
|
|
|
1057 mode-name "Hyper-Help")
|
|
|
1058 (set-syntax-table emacs-lisp-mode-syntax-table)
|
|
|
1059 (use-local-map hyper-apropos-help-map))
|
|
|
1060
|
|
|
1061 ;; ---------------------------------------------------------------------- ;;
|
|
|
1062
|
|
|
1063 (defun hyper-apropos-scroll-up ()
|
|
|
1064 "Scroll up the \"*Hyper Help*\" buffer if it's visible.
|
|
|
1065 Otherwise, scroll the selected window up."
|
|
|
1066 (interactive)
|
|
|
1067 (let ((win (get-buffer-window hyper-apropos-help-buf))
|
|
|
1068 (owin (selected-window)))
|
|
|
1069 (if win
|
|
|
1070 (progn
|
|
|
1071 (select-window win)
|
|
|
1072 (condition-case nil
|
|
|
1073 (scroll-up nil)
|
|
|
1074 (error (goto-char (point-max))))
|
|
|
1075 (select-window owin))
|
|
|
1076 (scroll-up nil))))
|
|
|
1077
|
|
|
1078 (defun hyper-apropos-scroll-down ()
|
|
|
1079 "Scroll down the \"*Hyper Help*\" buffer if it's visible.
|
|
|
1080 Otherwise, scroll the selected window down."
|
|
|
1081 (interactive)
|
|
|
1082 (let ((win (get-buffer-window hyper-apropos-help-buf))
|
|
|
1083 (owin (selected-window)))
|
|
|
1084 (if win
|
|
|
1085 (progn
|
|
|
1086 (select-window win)
|
|
|
1087 (condition-case nil
|
|
|
1088 (scroll-down nil)
|
|
|
1089 (error (goto-char (point-max))))
|
|
|
1090 (select-window owin))
|
|
|
1091 (scroll-down nil))))
|
|
|
1092
|
|
|
1093 ;; ---------------------------------------------------------------------- ;;
|
|
|
1094
|
|
|
1095 (defun hyper-apropos-mouse-get-doc (event)
|
|
|
1096 "Get the documentation for the symbol the mouse is on."
|
|
|
1097 (interactive "e")
|
|
|
1098 (mouse-set-point event)
|
|
|
1099 (let ((e (extent-at (point) nil 'hyper-apropos-custom)))
|
|
|
1100 (if e
|
|
|
1101 (funcall (extent-property e 'hyper-apropos-custom))
|
|
|
1102 (save-excursion
|
|
|
1103 (let ((symbol (hyper-apropos-this-symbol)))
|
|
|
1104 (if symbol
|
|
|
1105 (hyper-apropos-get-doc symbol)
|
|
|
1106 (error "Click on a symbol")))))))
|
|
|
1107
|
|
|
1108 ;; ---------------------------------------------------------------------- ;;
|
|
|
1109
|
|
|
1110 (defun hyper-apropos-add-keyword (pattern)
|
|
|
1111 "Use additional keyword to narrow regexp match.
|
|
|
1112 Deletes lines which don't match PATTERN."
|
|
|
1113 (interactive "sAdditional Keyword: ")
|
|
|
1114 (save-excursion
|
|
|
1115 (goto-char (point-min))
|
|
|
1116 (let (buffer-read-only)
|
|
|
1117 (keep-lines (concat pattern "\\|" hyper-apropos-junk-regexp))
|
|
|
1118 )))
|
|
|
1119
|
|
|
1120 (defun hyper-apropos-eliminate-keyword (pattern)
|
|
|
1121 "Use additional keyword to eliminate uninteresting matches.
|
|
|
1122 Deletes lines which match PATTERN."
|
|
|
1123 (interactive "sKeyword to eliminate: ")
|
|
|
1124 (save-excursion
|
|
|
1125 (goto-char (point-min))
|
|
|
1126 (let (buffer-read-only)
|
|
|
1127 (flush-lines pattern))
|
|
|
1128 ))
|
|
|
1129
|
|
|
1130 ;; ---------------------------------------------------------------------- ;;
|
|
|
1131
|
|
|
1132 (defun hyper-apropos-this-symbol ()
|
|
|
1133 (save-excursion
|
|
|
1134 (cond ((eq major-mode 'hyper-apropos-mode)
|
|
|
1135 (beginning-of-line)
|
|
|
1136 (if (looking-at hyper-apropos-junk-regexp)
|
|
|
1137 nil
|
|
|
1138 (forward-char 3)
|
|
|
1139 (read (point-marker))))
|
|
444
|
1140 ;; What's this? This ends up in the same symbol already described.
|
|
|
1141 ;; ((and
|
|
|
1142 ;; (eq major-mode 'hyper-apropos-help-mode)
|
|
|
1143 ;; (> (point) (point-min)))
|
|
|
1144 ;; (save-excursion
|
|
|
1145 ;; (goto-char (point-min))
|
|
|
1146 ;; (hyper-apropos-this-symbol)))
|
|
428
|
1147 (t
|
|
|
1148 (let* ((st (progn
|
|
|
1149 (skip-syntax-backward "w_")
|
|
|
1150 ;; !@(*$^%%# stupid backquote implementation!!!
|
|
|
1151 (skip-chars-forward "`")
|
|
|
1152 (point)))
|
|
|
1153 (en (progn
|
|
|
1154 (skip-syntax-forward "w_")
|
|
|
1155 (skip-chars-backward ".':") ; : for Local Variables
|
|
|
1156 (point))))
|
|
|
1157 (and (not (eq st en))
|
|
|
1158 (intern-soft (buffer-substring st en))))))))
|
|
|
1159
|
|
|
1160 (defun hyper-apropos-where-is (symbol)
|
|
|
1161 "Find keybinding for symbol on current line."
|
|
|
1162 (interactive (list (hyper-apropos-this-symbol)))
|
|
|
1163 (where-is symbol))
|
|
|
1164
|
|
|
1165 (defun hyper-apropos-invoke-fn (fn)
|
|
|
1166 "Interactively invoke the function on the current line."
|
|
|
1167 (interactive (list (hyper-apropos-this-symbol)))
|
|
|
1168 (cond ((not (fboundp fn))
|
|
|
1169 (error "%S is not a function" fn))
|
|
|
1170 (t (call-interactively fn))))
|
|
|
1171
|
|
|
1172 ;;;###autoload
|
|
|
1173 (defun hyper-set-variable (var val &optional this-ref-buffer)
|
|
|
1174 (interactive
|
|
|
1175 (let ((var (hyper-apropos-read-variable-symbol
|
|
|
1176 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
|
|
|
1177 "In ref buffer, set user option"
|
|
|
1178 "Set user option")
|
|
|
1179 'user-variable-p)))
|
|
|
1180 (list var (hyper-apropos-read-variable-value var) current-prefix-arg)))
|
|
|
1181 (hyper-apropos-set-variable var val this-ref-buffer))
|
|
|
1182
|
|
|
1183 ;;;###autoload
|
|
|
1184 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer)
|
|
|
1185 "Interactively set the variable on the current line."
|
|
|
1186 (interactive
|
|
|
1187 (let ((var (hyper-apropos-this-symbol)))
|
|
|
1188 (or (and var (boundp var))
|
|
|
1189 (setq var nil))
|
|
|
1190 (list var (hyper-apropos-read-variable-value var))))
|
|
|
1191 (and var
|
|
|
1192 (boundp var)
|
|
|
1193 (progn
|
|
|
1194 (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
|
|
|
1195 (save-excursion
|
|
|
1196 (set-buffer hyper-apropos-ref-buffer)
|
|
|
1197 (set var val))
|
|
|
1198 (set var val))
|
|
|
1199 (hyper-apropos-get-doc var t '(variable) this-ref-buffer))))
|
|
|
1200 ;;;###autoload
|
|
|
1201 (define-obsolete-function-alias
|
|
|
1202 'hypropos-set-variable 'hyper-apropos-set-variable)
|
|
|
1203
|
|
|
1204 (defun hyper-apropos-read-variable-value (var &optional this-ref-buffer)
|
|
|
1205 (and var
|
|
|
1206 (boundp var)
|
|
|
1207 (let ((prop (get var 'variable-interactive))
|
|
|
1208 (print-readably t)
|
|
|
1209 val str)
|
|
|
1210 (hyper-apropos-get-doc var t '(variable) current-prefix-arg)
|
|
|
1211 (if prop
|
|
|
1212 (call-interactively (list 'lambda '(arg)
|
|
|
1213 (list 'interactive prop)
|
|
|
1214 'arg))
|
|
|
1215 (setq val (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
|
|
|
1216 (save-excursion
|
|
|
1217 (set-buffer hyper-apropos-ref-buffer)
|
|
|
1218 (symbol-value var))
|
|
|
1219 (symbol-value var))
|
|
|
1220 str (prin1-to-string val))
|
|
|
1221 (eval-minibuffer
|
|
|
1222 (format "Set %s `%s' to value (evaluated): "
|
|
|
1223 (if (user-variable-p var) "user option" "Variable")
|
|
|
1224 var)
|
|
|
1225 (condition-case nil
|
|
|
1226 (progn
|
|
|
1227 (read str)
|
|
|
1228 (format (if (or (consp val)
|
|
|
1229 (and (symbolp val)
|
|
|
1230 (not (memq val '(t nil)))))
|
|
|
1231 "'%s" "%s")
|
|
|
1232 str))
|
|
|
1233 (error nil)))))))
|
|
|
1234
|
|
|
1235 (defun hyper-apropos-customize-variable ()
|
|
|
1236 (interactive)
|
|
|
1237 (let ((var (hyper-apropos-this-symbol)))
|
|
430
|
1238 (and
|
|
|
1239 (or (and var (boundp var))
|
|
|
1240 (setq var nil))
|
|
|
1241 (customize-variable var))))
|
|
428
|
1242
|
|
|
1243 ;; ---------------------------------------------------------------------- ;;
|
|
|
1244
|
|
|
1245 (defun hyper-apropos-find-tag (&optional tag-name)
|
|
|
1246 "Find the tag for the symbol on the current line in other window. In
|
|
|
1247 order for this to work properly, the variable `tag-table-alist' or
|
|
|
1248 `tags-file-name' must be set so that a TAGS file with tags for the emacs
|
|
|
1249 source is found for the \"*Hyper Apropos*\" buffer."
|
|
|
1250 (interactive)
|
|
|
1251 ;; there ought to be a default tags file for this...
|
|
|
1252 (or tag-name (setq tag-name (symbol-name (hyper-apropos-this-symbol))))
|
|
|
1253 (find-tag-other-window (list tag-name)))
|
|
|
1254
|
|
|
1255 ;; ---------------------------------------------------------------------- ;;
|
|
|
1256
|
|
|
1257 (defun hyper-apropos-find-function (fn)
|
|
|
1258 "Find the function for the symbol on the current line in other
|
|
|
1259 window. (See also `find-function'.)"
|
|
|
1260 (interactive
|
|
|
1261 (let ((fn (hyper-apropos-this-symbol)))
|
|
|
1262 (or (fboundp fn)
|
|
|
1263 (setq fn nil))
|
|
|
1264 (list fn)))
|
|
|
1265 (if fn
|
|
776
|
1266 (if-fboundp 'find-function-other-window
|
|
|
1267 (find-function-other-window fn)
|
|
|
1268 (error 'unimplemented "`find-func' package unavailable"))))
|
|
428
|
1269
|
|
718
|
1270 (defun hyper-apropos-find-variable (fn)
|
|
|
1271 "Find the variable for the symbol on the current line in other
|
|
|
1272 window. (See also `find-variable'.)"
|
|
|
1273 (interactive
|
|
|
1274 (let ((fn (hyper-apropos-this-symbol)))
|
|
|
1275 (or (boundp fn)
|
|
|
1276 (setq fn nil))
|
|
|
1277 (list fn)))
|
|
|
1278 (if fn
|
|
776
|
1279 (if-fboundp 'find-variable-other-window
|
|
|
1280 (find-variable-other-window fn)
|
|
|
1281 (error 'unimplemented "`find-func' package unavailable"))))
|
|
718
|
1282
|
|
428
|
1283 ;; ---------------------------------------------------------------------- ;;
|
|
|
1284
|
|
|
1285 (defun hyper-apropos-disassemble (sym)
|
|
|
1286 "Disassemble FUN if it is byte-coded. If it's a lambda, prettyprint it."
|
|
|
1287 (interactive (list (hyper-apropos-this-symbol)))
|
|
|
1288 (let ((fun sym) (trail nil) macrop)
|
|
|
1289 (while (and (symbolp fun) (not (memq fun trail)))
|
|
|
1290 (setq trail (cons fun trail)
|
|
|
1291 fun (symbol-function fun)))
|
|
|
1292 (and (symbolp fun)
|
|
|
1293 (error "Loop detected in function binding of `%s'" fun))
|
|
|
1294 (setq macrop (and (consp fun)
|
|
|
1295 (eq 'macro (car fun))))
|
|
|
1296 (cond ((compiled-function-p (if macrop (cdr fun) fun))
|
|
|
1297 (disassemble fun)
|
|
|
1298 (set-buffer "*Disassemble*")
|
|
|
1299 (goto-char (point-min))
|
|
|
1300 (forward-sexp 2)
|
|
|
1301 (insert (format " for function `%S'" sym))
|
|
|
1302 )
|
|
|
1303 ((consp fun)
|
|
|
1304 (with-current-buffer "*Disassemble*"
|
|
|
1305 (cl-prettyprint (if macrop
|
|
|
1306 (cons 'defmacro (cons sym (cdr (cdr fun))))
|
|
|
1307 (cons 'defun (cons sym (cdr fun))))))
|
|
|
1308 (set-buffer "*Disassemble*")
|
|
|
1309 (emacs-lisp-mode))
|
|
|
1310 ((or (vectorp fun) (stringp fun))
|
|
|
1311 ;; #### - do something fancy here
|
|
|
1312 (with-output-to-temp-buffer "*Disassemble*"
|
|
|
1313 (princ (format "%s is a keyboard macro:\n\n\t" sym))
|
|
|
1314 (prin1 fun)))
|
|
|
1315 (t
|
|
|
1316 (error "Sorry, cannot disassemble `%s'" sym)))))
|
|
|
1317
|
|
|
1318 ;; ---------------------------------------------------------------------- ;;
|
|
|
1319
|
|
|
1320 (defun hyper-apropos-quit ()
|
|
|
1321 (interactive)
|
|
|
1322 "Quit Hyper Apropos and restore original window config."
|
|
|
1323 (let ((buf (get-buffer hyper-apropos-apropos-buf)))
|
|
|
1324 (and buf (bury-buffer buf)))
|
|
|
1325 (set-window-configuration hyper-apropos-prev-wconfig))
|
|
|
1326
|
|
|
1327 ;; ---------------------------------------------------------------------- ;;
|
|
|
1328
|
|
|
1329 ;;;###autoload
|
|
|
1330 (defun hyper-apropos-popup-menu (event)
|
|
|
1331 (interactive "e")
|
|
|
1332 (mouse-set-point event)
|
|
430
|
1333 (let* ((sym (hyper-apropos-this-symbol))
|
|
428
|
1334 (notjunk (not (null sym)))
|
|
|
1335 (command-p (if (commandp sym) t))
|
|
|
1336 (variable-p (and sym (boundp sym)))
|
|
|
1337 (customizable-p (and variable-p
|
|
|
1338 (get sym 'custom-type)
|
|
|
1339 t))
|
|
|
1340 (function-p (fboundp sym))
|
|
|
1341 (apropos-p (eq 'hyper-apropos-mode
|
|
|
1342 (save-excursion (set-buffer (event-buffer event))
|
|
|
1343 major-mode)))
|
|
|
1344 (name (if sym (symbol-name sym) ""))
|
|
|
1345 (hyper-apropos-menu
|
|
|
1346 (delete
|
|
|
1347 nil
|
|
|
1348 (list (concat "Hyper-Help: " name)
|
|
|
1349 (vector "Display documentation" 'hyper-apropos-get-doc notjunk)
|
|
|
1350 (vector "Set variable" 'hyper-apropos-set-variable variable-p)
|
|
|
1351 (vector "Customize variable" 'hyper-apropos-customize-variable
|
|
|
1352 customizable-p)
|
|
|
1353 (vector "Show keys for" 'hyper-apropos-where-is command-p)
|
|
|
1354 (vector "Invoke command" 'hyper-apropos-invoke-fn command-p)
|
|
1039
|
1355 (vector "Find function" 'hyper-apropos-find-function function-p)
|
|
|
1356 (vector "Find variable" 'hyper-apropos-find-variable variable-p)
|
|
428
|
1357 (vector "Find tag" 'hyper-apropos-find-tag notjunk)
|
|
|
1358 (and apropos-p
|
|
|
1359 ["Add keyword..." hyper-apropos-add-keyword t])
|
|
|
1360 (and apropos-p
|
|
|
1361 ["Eliminate keyword..." hyper-apropos-eliminate-keyword t])
|
|
|
1362 (if apropos-p
|
|
|
1363 ["Programmers' Apropos" hyper-apropos-toggle-programming-flag
|
|
|
1364 :style toggle :selected hyper-apropos-programming-apropos]
|
|
|
1365 ["Programmers' Help" hyper-apropos-toggle-programming-flag
|
|
|
1366 :style toggle :selected hyper-apropos-programming-apropos])
|
|
|
1367 (and hyper-apropos-programming-apropos
|
|
|
1368 (vector "Disassemble function"
|
|
|
1369 'hyper-apropos-disassemble
|
|
|
1370 function-p))
|
|
|
1371 ["Help" describe-mode t]
|
|
|
1372 ["Quit" hyper-apropos-quit t]
|
|
|
1373 ))))
|
|
|
1374 (popup-menu hyper-apropos-menu)))
|
|
|
1375 ;;;###autoload
|
|
|
1376 (define-obsolete-function-alias
|
|
|
1377 'hypropos-popup-menu 'hyper-apropos-popup-menu)
|
|
|
1378
|
|
|
1379 (provide 'hyper-apropos)
|
|
|
1380
|
|
|
1381 ;; end of hyper-apropos.el
|
