annotate lisp/hyper-apropos.el @ 931:3508e2f71814

[xemacs-hg @ 2002-07-24 04:46:29 by andyp] gutter enhancement
author andyp
date Wed, 24 Jul 2002 04:46:29 +0000
parents 79940b592197
children a97af4f94589
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
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 718
diff changeset
1235 (if-fboundp 'find-function-other-window
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 718
diff changeset
1236 (find-function-other-window fn)
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 718
diff changeset
1237 (error 'unimplemented "`find-func' package unavailable"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238
718
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1239 (defun hyper-apropos-find-variable (fn)
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1240 "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
1241 window. (See also `find-variable'.)"
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1242 (interactive
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1243 (let ((fn (hyper-apropos-this-symbol)))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1244 (or (boundp fn)
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1245 (setq fn nil))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1246 (list fn)))
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1247 (if fn
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 718
diff changeset
1248 (if-fboundp 'find-variable-other-window
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 718
diff changeset
1249 (find-variable-other-window fn)
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 718
diff changeset
1250 (error 'unimplemented "`find-func' package unavailable"))))
718
29e4e3036b4e [xemacs-hg @ 2001-12-28 01:38:41 by youngs]
youngs
parents: 502
diff changeset
1251
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 (defun hyper-apropos-disassemble (sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 "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
1256 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 (let ((fun sym) (trail nil) macrop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 (while (and (symbolp fun) (not (memq fun trail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 (setq trail (cons fun trail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 fun (symbol-function fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 (and (symbolp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (error "Loop detected in function binding of `%s'" fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 (setq macrop (and (consp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 (eq 'macro (car fun))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 (cond ((compiled-function-p (if macrop (cdr fun) fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 (disassemble fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 (set-buffer "*Disassemble*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 (forward-sexp 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 (insert (format " for function `%S'" sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 ((consp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 (with-current-buffer "*Disassemble*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 (cl-prettyprint (if macrop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 (cons 'defmacro (cons sym (cdr (cdr fun))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 (cons 'defun (cons sym (cdr fun))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 (set-buffer "*Disassemble*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 (emacs-lisp-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 ((or (vectorp fun) (stringp fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 ;; #### - do something fancy here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 (with-output-to-temp-buffer "*Disassemble*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 (princ (format "%s is a keyboard macro:\n\n\t" sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 (prin1 fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 (error "Sorry, cannot disassemble `%s'" sym)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (defun hyper-apropos-quit ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 "Quit Hyper Apropos and restore original window config."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 (let ((buf (get-buffer hyper-apropos-apropos-buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 (and buf (bury-buffer buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 (set-window-configuration hyper-apropos-prev-wconfig))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 (defun hyper-apropos-popup-menu (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 (interactive "e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 (mouse-set-point event)
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1302 (let* ((sym (hyper-apropos-this-symbol))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 (notjunk (not (null sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 (command-p (if (commandp sym) t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 (variable-p (and sym (boundp sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 (customizable-p (and variable-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 (get sym 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 (function-p (fboundp sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 (apropos-p (eq 'hyper-apropos-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 (save-excursion (set-buffer (event-buffer event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 major-mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 (name (if sym (symbol-name sym) ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (hyper-apropos-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 (delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 (list (concat "Hyper-Help: " name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 (vector "Display documentation" 'hyper-apropos-get-doc notjunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (vector "Set variable" 'hyper-apropos-set-variable variable-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 (vector "Customize variable" 'hyper-apropos-customize-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 customizable-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 (vector "Show keys for" 'hyper-apropos-where-is command-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 (vector "Invoke command" 'hyper-apropos-invoke-fn command-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (vector "Find function" 'hyper-apropos-find-function function-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 (vector "Find tag" 'hyper-apropos-find-tag notjunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 (and apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 ["Add keyword..." hyper-apropos-add-keyword t])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 (and apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 ["Eliminate keyword..." hyper-apropos-eliminate-keyword t])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 (if apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 ["Programmers' Apropos" hyper-apropos-toggle-programming-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 :style toggle :selected hyper-apropos-programming-apropos]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 ["Programmers' Help" hyper-apropos-toggle-programming-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 :style toggle :selected hyper-apropos-programming-apropos])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 (and hyper-apropos-programming-apropos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 (vector "Disassemble function"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 'hyper-apropos-disassemble
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 function-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 ["Help" describe-mode t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 ["Quit" hyper-apropos-quit t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 (popup-menu hyper-apropos-menu)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 'hypropos-popup-menu 'hyper-apropos-popup-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 (provide 'hyper-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 ;; end of hyper-apropos.el