annotate lisp/hyper-apropos.el @ 4843:715b15990d0a

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