annotate lisp/hyper-apropos.el @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 29e4e3036b4e
children 79940b592197
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Copyright (C) 1996 Ben Wing.
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 This map inherits from `hyper-apropos-help-map.'")
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)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (hyper-apropos-grok-functions flist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (insert-face "\n\nVariables and Constants:\n\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 'hyper-apropos-major-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (hyper-apropos-grok-variables vlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (goto-char (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (switch-to-buffer hyper-apropos-apropos-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (hyper-apropos-mode regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (defun hyper-apropos-toggle-programming-flag ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (with-current-buffer hyper-apropos-apropos-buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (set (make-local-variable 'hyper-apropos-programming-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (not hyper-apropos-programming-apropos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (message "Re-running apropos...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (hyper-apropos hyper-apropos-last-regexp nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (defun hyper-apropos-grok-functions (fns)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (let (bind doc type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (dolist (fn fns)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (setq bind (symbol-function fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 type (cond ((subrp bind) ?i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ((compiled-function-p bind) ?b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 ((consp bind) (or (cdr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (assq (car bind) '((autoload . ?a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (lambda . ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (macro . ?m))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 ??))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (t ?\ )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (insert type (if (commandp fn) "* " " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (set-extent-property e 'mouse-face 'highlight))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (insert-char ?\ (let ((l (- 30 (length (format "%S" fn)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (if (natnump l) l 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (and hyper-apropos-show-brief-docs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (setq doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ;; A symbol's function slot can point to an unbound symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 ;; In that case, `documentation' will fail.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (ignore-errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (documentation fn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (if (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 "^([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (setq doc (substring doc (match-end 0) (string-match "\n" doc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (insert-face (if doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (concat " - "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (substring doc 0 (string-match "\n" doc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 " Not documented.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 'hyper-apropos-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (insert ?\n))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (defun hyper-apropos-grok-variables (vars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (let (doc userp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (dolist (var vars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (setq userp (user-variable-p var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (insert (if userp " * " " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (set-extent-property e 'mouse-face 'highlight))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (insert-char ?\ (let ((l (- 30 (length (format "%S" var)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (if (natnump l) l 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (and hyper-apropos-show-brief-docs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (setq doc (documentation-property var 'variable-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (insert-face (if doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (concat " - " (substring doc (if userp 1 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (string-match "\n" doc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 " - Not documented.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 'hyper-apropos-documentation))
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defun hyper-apropos-mode (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 "Improved apropos mode for displaying Emacs documentation. Function and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 variable names are displayed in the buffer \"*Hyper Apropos*\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Functions are preceded by a single character to indicates their types:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Interactive functions are also preceded by an asterisk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 Variables are preceded by an asterisk if they are user variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 General Commands:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 SPC - scroll documentation or apropos window forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 b - scroll documentation or apropos window backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 k - eliminate all hits that don't contain keyword
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 n - new search
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 / - isearch-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 q - quit and restore previous window configuration
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 Operations for Symbol on Current Line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 RET - toggle display of symbol's documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (also on button2 in xemacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 w - show the keybinding if symbol is a command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 i - invoke function on current line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 s - set value of variable on current line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 t - display the C or lisp source (find-tag)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (delete-other-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (setq mode-name "Hyper-Apropos"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 major-mode 'hyper-apropos-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 buffer-read-only t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 truncate-lines t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 hyper-apropos-last-regexp regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 modeline-buffer-identification
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (list (cons modeline-buffer-id-left-extent "Hyper Apropos: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (cons modeline-buffer-id-right-extent (concat "\"" regexp "\""))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (use-local-map hyper-apropos-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (run-hooks 'hyper-apropos-mode-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ;; similar to `describe-key-briefly', copied from help.el by CW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (defun hyper-describe-key (key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (interactive "kDescribe key: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (hyper-describe-key-briefly key t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (defun hyper-describe-key-briefly (key &optional show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (interactive "kDescribe key briefly: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (let (menup defn interm final msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (setq defn (key-or-menu-binding key 'menup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (if (or (null defn) (integerp defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (or (numberp show) (message "%s is undefined" (key-description key)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (cond ((stringp defn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (setq interm defn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 final (key-binding defn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 ((vectorp defn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (setq interm (append defn nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (while (and interm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (member (key-binding (vector (car interm)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 '(universal-argument digit-argument)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (setq interm (cdr interm)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (while (and interm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (not (setq final (key-binding (vconcat interm)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (setq interm (butlast interm)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (if final
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (setq interm (vconcat interm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (setq interm defn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 final (key-binding defn)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (setq msg (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 "%s runs %s%s%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 ;; This used to say 'This menu item' but it could also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 ;; be a scrollbar event. We can't distinguish at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 ;; moment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (if menup "This item" (key-description key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 ;;(if (symbolp defn) defn (key-description defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (if (symbolp defn) defn (prin1-to-string defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (if final (concat ", " (key-description interm) " runs ") "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (if final
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (if (symbolp final) final (prin1-to-string final))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (if (numberp show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (or (not (symbolp defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (memq (symbol-function defn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 '(zkey-init-kbd-macro zkey-init-kbd-fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (progn (princ msg) (princ "\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (message "%s" msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (if final (setq defn final))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 defn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 show)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
462 (hyper-apropos-get-doc defn t))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
463 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
464 (setq hyper-apropos-prev-wconfig (current-window-configuration)))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (defun hyper-describe-face (symbol &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 "Describe face..
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 See also `hyper-apropos' and `hyper-describe-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (let (v val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (setq v (hyper-apropos-this-symbol)) ; symbol under point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (or (find-face v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (setq v (variable-at-point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (setq val (let ((enable-recursive-minibuffers t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (concat (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 "Follow face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 "Describe face")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (if v
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (format " (default %s): " v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 ": "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (mapcar #'(lambda (x) (list (symbol-name x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (face-list))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
486 nil t nil 'hyper-apropos-face-history
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
487 (and v (symbol-name v)))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
488 (list (intern-soft val)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (defun hyper-describe-variable (symbol &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 "Hypertext drop-in replacement for `describe-variable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 See also `hyper-apropos' and `hyper-describe-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (interactive (list (hyper-apropos-read-variable-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 "Follow variable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 "Describe variable"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (defun hyper-where-is (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 "Print message listing key sequences that invoke specified command."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (interactive (list (hyper-apropos-read-function-symbol "Where is function")))
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 (where-is symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (defun hyper-describe-function (symbol &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 "Hypertext replacement for `describe-function'. Unlike `describe-function'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 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
524 See also `hyper-apropos' and `hyper-describe-variable'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (interactive (list (hyper-apropos-read-function-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 "Follow function"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 "Describe function"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (defun hyper-apropos-read-variable-symbol (prompt &optional predicate)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 "Hypertext drop-in replacement for `describe-variable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 See also `hyper-apropos' and `hyper-describe-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (or predicate (setq predicate 'boundp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (let (v val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (setq v (hyper-apropos-this-symbol)) ; symbol under point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (or (funcall predicate v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (setq v (variable-at-point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (or (funcall predicate v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (setq v nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (setq val (let ((enable-recursive-minibuffers t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (concat prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (if v
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (format " (default %s): " v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 ": "))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
555 obarray predicate t nil 'variable-history
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
556 (and v (symbol-name v)))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
557 (intern-soft val)))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
558
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol)
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 (defun hyper-apropos-read-function-symbol (prompt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 "Read function symbol from minibuffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (let ((fn (hyper-apropos-this-symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (or (fboundp fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (setq fn (function-at-point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (setq val (let ((enable-recursive-minibuffers t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (completing-read (if fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (format "%s (default %s): " prompt fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (format "%s: " prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 obarray 'fboundp t nil
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
574 'function-history
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
575 (and fn (symbol-name fn)))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
576 (intern-soft val)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (defun hyper-apropos-last-help (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 "Go back to the last symbol documented in the *Hyper Help* buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (let ((win (get-buffer-window hyper-apropos-help-buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (or arg (setq arg (if win 1 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (cond ((= arg 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ((<= (length hyper-apropos-help-history) arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ;; go back as far as we can...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (setcdr (nreverse hyper-apropos-help-history) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (setq hyper-apropos-help-history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (nthcdr arg hyper-apropos-help-history))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (if (or win (> arg 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (hyper-apropos-get-doc (car hyper-apropos-help-history) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (display-buffer hyper-apropos-help-buf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (defun hyper-apropos-insert-face (string &optional face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 "Insert STRING and fontify some parts with face `hyper-apropos-hyperlink'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (let ((beg (point)) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (insert-face string (or face 'hyper-apropos-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (setq end (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (goto-char beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (while (re-search-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 "`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 end 'limit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (let ((e (make-extent (match-beginning 1) (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (set-extent-face e 'hyper-apropos-hyperlink)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (set-extent-property e 'mouse-face 'highlight)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (goto-char beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (while (re-search-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 "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
609 end 'limit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (let ((e (make-extent (match-beginning 1) (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (set-extent-face e 'hyper-apropos-hyperlink)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (set-extent-property e 'mouse-face 'highlight)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (defun hyper-apropos-insert-keybinding (keys string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (if keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (insert " (" string " bound to \""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (mapconcat 'key-description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (sort* keys #'< :key #'length)
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 "\")\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (defun hyper-apropos-insert-section-heading (alias-desc &optional desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (or desc (setq desc alias-desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 alias-desc nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (if alias-desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (setq desc (concat alias-desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (if (memq (aref desc 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 '(?a ?e ?i ?o ?u))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 ", an " ", a ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 desc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (aset desc 0 (upcase (aref desc 0))) ; capitalize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (newline 3) (delete-blank-lines) (newline 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 (hyper-apropos-insert-face desc 'hyper-apropos-section-heading))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (defun hyper-apropos-insert-value (string symbol val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (insert-face string 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (insert (if (symbol-value symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (if (or (null val) (eq val t) (integerp val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 (symbol-value symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 (set symbol nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 "see below")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 "is void")))
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 (defun hyper-apropos-follow-ref-buffer (this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (and (not this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (eq major-mode 'hyper-apropos-help-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 hyper-apropos-ref-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (buffer-live-p hyper-apropos-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (defun hyper-apropos-get-alias (symbol alias-p next-symbol &optional use)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 "Return (TERMINAL-SYMBOL . ALIAS-DESC)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (let (aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (while (funcall alias-p symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (setq aliases (cons (if use (funcall use symbol) symbol) aliases))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (setq symbol (funcall next-symbol symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (cons symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (and aliases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (concat "an alias for `"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (mapconcat 'symbol-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (nreverse aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 "',\nwhich is an alias for `")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 "'")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (defun hyper-apropos-get-doc (&optional symbol force type this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 ;; #### - update this docstring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 "Toggle display of documentation for the symbol on the current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;; SYMBOL is the symbol to document. FORCE, if non-nil, means to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ;; regenerate the documentation even if it already seems to be there. And
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 ;; TYPE, if present, forces the generation of only variable documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 ;; or only function documentation. Normally, if both are present, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 ;; both will be generated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 ;; TYPES TO IMPLEMENT: obsolete face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (or symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (setq symbol (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (or type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (setq type '(function variable face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (if (and (eq hyper-apropos-currently-showing symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (get-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (get-buffer-window hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (not force))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ;; we're already displaying this help, so toggle its display.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (delete-windows-on hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 ;; OK, we've got to refresh and display it...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (or (eq symbol (car hyper-apropos-help-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (setq hyper-apropos-help-history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (if (eq major-mode 'hyper-apropos-help-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;; if we're following a link in the help buffer, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 ;; record that in the help history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (cons symbol hyper-apropos-help-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 ;; otherwise clear the history because it's a new search.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (list symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (set-buffer hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (setq hyper-apropos-ref-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (let (standard-output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 ok beg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 newsym symtype doc obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (local mode-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 global local-str global-str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 font fore back undl
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 aliases alias-desc desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (set-buffer (get-buffer-create hyper-apropos-help-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 ;;(setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (insert-face (format "`%s'" symbol) 'hyper-apropos-major-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (insert (format " (buffer: %s, mode: %s)\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (buffer-name hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 local)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 ;; function ----------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (and (memq 'function type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (fboundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (setq ok t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (setq aliases (hyper-apropos-get-alias (symbol-function symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 'symbolp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 'symbol-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 newsym (car aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 alias-desc (cdr aliases))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 (if (eq 'macro (car-safe newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (setq desc "macro"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 newsym (cdr newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (setq desc "function"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (setq symtype (cond ((subrp newsym) 'subr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ((compiled-function-p newsym) 'bytecode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 ((eq (car-safe newsym) 'autoload) 'autoload)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 ((eq (car-safe newsym) 'lambda) 'lambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 desc (concat (if (commandp symbol) "interactive ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 (cdr (assq symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 '((subr . "built-in ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (bytecode . "compiled Lisp ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (autoload . "autoloaded Lisp ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (lambda . "Lisp "))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (case symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 ((autoload) (format ",\n(autoloaded from \"%s\")"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (nth 1 newsym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 ((bytecode) (format ",\n(loaded from \"%s\")"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (symbol-file symbol)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 local (current-local-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 global (current-global-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 obsolete (get symbol 'byte-obsolete-info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 doc (or (documentation symbol) "function not documented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (hyper-apropos-insert-section-heading alias-desc desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (insert ":\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (if local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (hyper-apropos-insert-keybinding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (where-is-internal symbol (list local) nil nil nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 "locally"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (hyper-apropos-insert-keybinding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (where-is-internal symbol (list global) nil nil nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 "globally")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (if obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (hyper-apropos-insert-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (format "%s is an obsolete function; %s\n\n" symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (if (stringp (car obsolete))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (car obsolete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (format "use `%s' instead." (car obsolete))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 'hyper-apropos-warning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (setq beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (insert-face "arguments: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (cond ((eq symtype 'lambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (princ (or (nth 1 newsym) "()")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 ((eq symtype 'bytecode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (princ (or (compiled-function-arglist newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 "()")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 ((and (eq symtype 'subr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (insert (substring doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (match-end 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 (setq doc (substring doc 0 (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 ((and (eq symtype 'subr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 \[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (insert "("
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (if (match-end 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (substring doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (match-end 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (setq doc (substring doc (match-end 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (t (princ "[not available]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 (insert "\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (hyper-apropos-insert-face doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 (indent-rigidly beg (point) 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 ;; variable ----------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 (and (memq 'variable type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (or (boundp symbol) (default-boundp symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 (setq ok t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (setq aliases (hyper-apropos-get-alias symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 'variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 'variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 'variable-alias)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 newsym (car aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 alias-desc (cdr aliases))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (setq symtype (or (local-variable-p newsym (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 (and (local-variable-p newsym
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 (current-buffer) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 'auto-local))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 desc (concat (and (get newsym 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 "customizable ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 (if (user-variable-p newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 "user variable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 "variable")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 (cond ((eq symtype t) ", buffer-local")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 ((eq symtype 'auto-local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 ", local when set")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 local (and (boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 (symbol-value newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 local-str (and (boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 (prin1-to-string local))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 global (and (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (default-boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 (default-value newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 global-str (and (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 (default-boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (prin1-to-string global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 obsolete (get symbol 'byte-obsolete-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 doc (or (documentation-property symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 'variable-documentation)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 "variable not documented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (hyper-apropos-insert-section-heading alias-desc desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (when (and (user-variable-p newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (get newsym 'custom-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 (let ((e (make-extent (point-at-bol) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (set-extent-property e 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (set-extent-property e 'help-echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 (format "Customize %s" newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (set-extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 e 'hyper-apropos-custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 `(lambda () (customize-variable (quote ,newsym))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (insert ":\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (setq beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 (if obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 (hyper-apropos-insert-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 (format "%s is an obsolete function; %s\n\n" symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (if (stringp obsolete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 (format "use `%s' instead." obsolete)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 'hyper-apropos-warning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 ;; generally, the value of the variable is short and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 ;; documentation of the variable long, so it's desirable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 ;; to see all of the value and the start of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 ;; documentation. Some variables, though, have huge and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 ;; nearly meaningless values that force you to page
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 ;; forward just to find the doc string. That is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 ;; undesirable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 (if (and (or (null local-str) (< (length local-str) 69))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (or (null global-str) (< (length global-str) 69)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 ; 80 cols. docstrings assume this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (progn (insert-face "value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 (insert (or local-str "is void"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 (if (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 (insert-face "default value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (insert (or global-str "is void"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (insert "\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (hyper-apropos-insert-face doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 (hyper-apropos-insert-value "value: " 'local-str local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (if (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 (insert ", ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (hyper-apropos-insert-value "default-value: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 'global-str global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 (insert "\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (hyper-apropos-insert-face doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (if local-str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (newline 3) (delete-blank-lines) (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 (insert-face "value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (if hyper-apropos-prettyprint-long-values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (cl-prettyprint local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (error (insert local-str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (insert local-str))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (if global-str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 (newline 3) (delete-blank-lines) (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 (insert-face "default value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 (if hyper-apropos-prettyprint-long-values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (cl-prettyprint global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (error (insert global-str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 (insert global-str)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 (indent-rigidly beg (point) 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 ;; face --------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (and (memq 'face type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (find-face symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 (setq ok t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 (copy-face symbol 'hyper-apropos-temp-face 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 (mapcar #'(lambda (property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (setq symtype (face-property-instance symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (if symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (set-face-property 'hyper-apropos-temp-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 symtype)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (setq font (cons (face-property-instance symbol 'font nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 (face-property-instance symbol 'font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 fore (cons (face-foreground-instance symbol nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 (face-foreground-instance symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 back (cons (face-background-instance symbol nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 (face-background-instance symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 undl (cons (face-underline-p symbol nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 (face-underline-p symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 doc (face-doc-string symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 ;; #### - add some code here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (hyper-apropos-insert-section-heading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 (concat "Face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 (when (get symbol 'face-defface-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 (let* ((str " (customizable)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 (e (make-extent 1 (length str) str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 (set-extent-property e 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 (set-extent-property e 'help-echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (format "Customize %s" symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 (set-extent-property e 'unique t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 (set-extent-property e 'duplicable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 (set-extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 e 'hyper-apropos-custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 `(lambda () (customize-face (quote ,symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 ":\n\n "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 (insert-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 ABCDEFHIJKLMNOPQRSTUVWXYZ abcdefhijklmnopqrstuvwxyz 0123456789"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 'hyper-apropos-temp-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 (newline 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (insert-face " Font: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (insert (format (if (numberp (car font)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (and (cdr font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 (font-instance-name (cdr font)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 (insert-face " Foreground: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 (insert (format (if (numberp (car fore)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 (and (cdr fore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 (color-instance-name (cdr fore)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 (insert-face " Background: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 (insert (format (if (numberp (car back)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (and (cdr back)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 (color-instance-name (cdr back)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 (insert-face " Underline: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (insert (format (if (numberp (car undl)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 (cdr undl)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (if doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (newline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (setq beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 (insert doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 (indent-rigidly beg (point) 2))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 ;; not bound & property list -----------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (or ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 (hyper-apropos-insert-section-heading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 "symbol is not currently bound\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (if (and (setq symtype (symbol-plist symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 (or (> (length symtype) 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 (not (memq 'variable-documentation symtype))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 (hyper-apropos-insert-section-heading "property-list:\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 (while symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 (if (memq (car symtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 '(variable-documentation byte-obsolete-info))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 (setq symtype (cdr symtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 (insert-face (concat " " (symbol-name (car symtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 (setq symtype (cdr symtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 (indent-to 32)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (insert (prin1-to-string (car symtype)) "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 (setq symtype (cdr symtype)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 ;; pop up window and shrink it if it's wasting space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (if hyper-apropos-shrink-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 (shrink-window-if-larger-than-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 (display-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (display-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 (setq hyper-apropos-currently-showing symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 'hypropos-get-doc 'hyper-apropos-get-doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 ; -----------------------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 (defun hyper-apropos-help-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 "Major mode for hypertext XEmacs help. In this mode, you can quickly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 follow links between back and forth between the documentation strings for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 different variables and functions. Common commands:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 \\{hyper-apropos-help-map}"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 (setq buffer-read-only t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 major-mode 'hyper-apropos-help-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 mode-name "Hyper-Help")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 (set-syntax-table emacs-lisp-mode-syntax-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 (use-local-map hyper-apropos-help-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 (defun hyper-apropos-scroll-up ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 "Scroll up the \"*Hyper Help*\" buffer if it's visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 Otherwise, scroll the selected window up."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 (let ((win (get-buffer-window hyper-apropos-help-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 (owin (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (if win
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (select-window win)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 (scroll-up nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 (error (goto-char (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 (select-window owin))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 (scroll-up nil))))
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 (defun hyper-apropos-scroll-down ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 "Scroll down the \"*Hyper Help*\" buffer if it's visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 Otherwise, scroll the selected window down."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 (let ((win (get-buffer-window hyper-apropos-help-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 (owin (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (if win
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (select-window win)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 (scroll-down nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (error (goto-char (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 (select-window owin))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 (scroll-down nil))))
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 (defun hyper-apropos-mouse-get-doc (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 "Get the documentation for the symbol the mouse is on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 (interactive "e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 (mouse-set-point event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 (let ((e (extent-at (point) nil 'hyper-apropos-custom)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 (if e
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (funcall (extent-property e 'hyper-apropos-custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (let ((symbol (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (if symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 (hyper-apropos-get-doc symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 (error "Click on a symbol")))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 (defun hyper-apropos-add-keyword (pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 "Use additional keyword to narrow regexp match.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 Deletes lines which don't match PATTERN."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 (interactive "sAdditional Keyword: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (let (buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (keep-lines (concat pattern "\\|" hyper-apropos-junk-regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 (defun hyper-apropos-eliminate-keyword (pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 "Use additional keyword to eliminate uninteresting matches.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 Deletes lines which match PATTERN."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (interactive "sKeyword to eliminate: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 (let (buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 (flush-lines pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 (defun hyper-apropos-this-symbol ()
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 (cond ((eq major-mode 'hyper-apropos-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 (if (looking-at hyper-apropos-junk-regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 (forward-char 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 (read (point-marker))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1109 ;; 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
1110 ;; ((and
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1111 ;; (eq major-mode 'hyper-apropos-help-mode)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1112 ;; (> (point) (point-min)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1113 ;; (save-excursion
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1114 ;; (goto-char (point-min))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1115 ;; (hyper-apropos-this-symbol)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (let* ((st (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 (skip-syntax-backward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 ;; !@(*$^%%# stupid backquote implementation!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (skip-chars-forward "`")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 (en (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (skip-syntax-forward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 (skip-chars-backward ".':") ; : for Local Variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 (and (not (eq st en))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 (intern-soft (buffer-substring st en))))))))
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 (defun hyper-apropos-where-is (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 "Find keybinding for symbol on current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 (where-is symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 (defun hyper-apropos-invoke-fn (fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 "Interactively invoke the function on the current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 (cond ((not (fboundp fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 (error "%S is not a function" fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 (t (call-interactively fn))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 (defun hyper-set-variable (var val &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 (let ((var (hyper-apropos-read-variable-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 "In ref buffer, set user option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 "Set user option")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 'user-variable-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 (list var (hyper-apropos-read-variable-value var) current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 (hyper-apropos-set-variable var val this-ref-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 "Interactively set the variable on the current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 (let ((var (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 (or (and var (boundp var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 (setq var nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 (list var (hyper-apropos-read-variable-value var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 (and var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 (set-buffer hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 (set var val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 (set var val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 (hyper-apropos-get-doc var t '(variable) this-ref-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 'hypropos-set-variable 'hyper-apropos-set-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 (defun hyper-apropos-read-variable-value (var &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 (and var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 (let ((prop (get var 'variable-interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 (print-readably t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 val str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 (hyper-apropos-get-doc var t '(variable) current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 (if prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 (call-interactively (list 'lambda '(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 (list 'interactive prop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 'arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 (setq val (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 (set-buffer hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 (symbol-value var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 (symbol-value var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 str (prin1-to-string val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 (eval-minibuffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 (format "Set %s `%s' to value (evaluated): "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 (if (user-variable-p var) "user option" "Variable")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 (read str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 (format (if (or (consp val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 (and (symbolp val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 (not (memq val '(t nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 "'%s" "%s")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 (error nil)))))))
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-customize-variable ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 (let ((var (hyper-apropos-this-symbol)))
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1207 (and
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1208 (or (and var (boundp var))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1209 (setq var nil))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1210 (customize-variable var))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 (defun hyper-apropos-find-tag (&optional tag-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 "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
1216 order for this to work properly, the variable `tag-table-alist' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 `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
1218 source is found for the \"*Hyper Apropos*\" buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 ;; there ought to be a default tags file for this...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 (or tag-name (setq tag-name (symbol-name (hyper-apropos-this-symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 (find-tag-other-window (list tag-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 (defun hyper-apropos-find-function (fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 "Find the function for the symbol on the current line in other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 window. (See also `find-function'.)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 (let ((fn (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 (or (fboundp fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 (setq fn nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 (list fn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 (if fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 (find-function-other-window fn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236
718
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1237 (defun hyper-apropos-find-variable (fn)
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1238 "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
1239 window. (See also `find-variable'.)"
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1240 (interactive
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1241 (let ((fn (hyper-apropos-this-symbol)))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1242 (or (boundp fn)
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1243 (setq fn nil))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1244 (list fn)))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1245 (if fn
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1246 (find-variable-other-window fn)))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1247
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 (defun hyper-apropos-disassemble (sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 "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
1252 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 (let ((fun sym) (trail nil) macrop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 (while (and (symbolp fun) (not (memq fun trail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 (setq trail (cons fun trail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 fun (symbol-function fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 (and (symbolp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 (error "Loop detected in function binding of `%s'" fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 (setq macrop (and (consp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 (eq 'macro (car fun))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 (cond ((compiled-function-p (if macrop (cdr fun) fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (disassemble fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 (set-buffer "*Disassemble*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 (forward-sexp 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 (insert (format " for function `%S'" sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 ((consp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 (with-current-buffer "*Disassemble*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 (cl-prettyprint (if macrop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 (cons 'defmacro (cons sym (cdr (cdr fun))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 (cons 'defun (cons sym (cdr fun))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 (set-buffer "*Disassemble*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 (emacs-lisp-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 ((or (vectorp fun) (stringp fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 ;; #### - do something fancy here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 (with-output-to-temp-buffer "*Disassemble*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 (princ (format "%s is a keyboard macro:\n\n\t" sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 (prin1 fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 (error "Sorry, cannot disassemble `%s'" sym)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282
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-quit ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 "Quit Hyper Apropos and restore original window config."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 (let ((buf (get-buffer hyper-apropos-apropos-buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (and buf (bury-buffer buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 (set-window-configuration hyper-apropos-prev-wconfig))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 (defun hyper-apropos-popup-menu (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 (interactive "e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 (mouse-set-point event)
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1298 (let* ((sym (hyper-apropos-this-symbol))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 (notjunk (not (null sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 (command-p (if (commandp sym) t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 (variable-p (and sym (boundp sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 (customizable-p (and variable-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 (get sym 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 (function-p (fboundp sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 (apropos-p (eq 'hyper-apropos-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 (save-excursion (set-buffer (event-buffer event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 major-mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 (name (if sym (symbol-name sym) ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 (hyper-apropos-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 (delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 (list (concat "Hyper-Help: " name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (vector "Display documentation" 'hyper-apropos-get-doc notjunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 (vector "Set variable" 'hyper-apropos-set-variable variable-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 (vector "Customize variable" 'hyper-apropos-customize-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 customizable-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 (vector "Show keys for" 'hyper-apropos-where-is command-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (vector "Invoke command" 'hyper-apropos-invoke-fn command-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 (vector "Find function" 'hyper-apropos-find-function function-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 (vector "Find tag" 'hyper-apropos-find-tag notjunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 (and apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 ["Add keyword..." hyper-apropos-add-keyword t])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (and apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 ["Eliminate keyword..." hyper-apropos-eliminate-keyword t])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 (if apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 ["Programmers' Apropos" hyper-apropos-toggle-programming-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 :style toggle :selected hyper-apropos-programming-apropos]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 ["Programmers' Help" hyper-apropos-toggle-programming-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 :style toggle :selected hyper-apropos-programming-apropos])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (and hyper-apropos-programming-apropos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (vector "Disassemble function"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 'hyper-apropos-disassemble
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 function-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 ["Help" describe-mode t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 ["Quit" hyper-apropos-quit t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 (popup-menu hyper-apropos-menu)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 'hypropos-popup-menu 'hyper-apropos-popup-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 (provide 'hyper-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 ;; end of hyper-apropos.el