annotate lisp/hyper-apropos.el @ 502:7039e6323819

[xemacs-hg @ 2001-05-04 22:41:46 by ben] ----------------------- byte-comp warning fixes ----------------- New functions for cleanly eliminating byte-compiler warnings. Their definitions require no changes at all in bytecomp.el, meaning that any package that wants to use them and be compatible with older versions of XEmacs need only copy the code and rename the functions (i.e. prefix them with the package name). Eliminate byte-compiler warnings using the new functions in bytecomp-runtime.el. Move coding-system-put,get,category, since they're not Mule-specific and are used in prefer-coding-system. font.el was incredibly ugly. Clean it up. Avoid using defsubst for any exported functions, to avoid possible compatibility problems if we later change the internal interface. (It happened before, with face accessors, between 19.8 and 19.9). Fix tons of warnings. Clean up (new function gpm-is-supported-p eliminates duplicate code in gpm-create/delete-device-hook) and eliminate warnings. ---------- make byte-recompile-directory work in the --------- core `lisp' dir, even in the absence of a Mule XEmacs (i.e. make it skip the Mule files rather than trying to compile them). now you should be able to do `touch *.el' in the `lisp' dir, then M-x byte-recompile-directory, and get no warnings. Avoid trying to compile Mule files in byte-recompile-directory when we're not in a Mule XEmacs, since we're highly likely to get syntax errors. Add a coding-system cookie to all Mule files so that byte-recompile-directory ignores them. Magic cookie function moved to files.el from code-files.el (for use by bytecomp even in a non-coding-system XEmacs), and changed names and semantics for use by bytecomp. NOTE: IMO this is an internal function that we can change as we like (and there is absolutely no code anywhere else using the function). ---------------- GUI improvements: menus, help ------------------- Rearrange order of keymap declarations to be alphabetical. Improve help on help to include all bindings, and group by category. Add bindings for new Info commands. Remove warnings. Use command-hyper-apropos in place of command-apropos. Add a function to do the equivalent of command-apropos. Evals its help-text argument so you can put expressions there. Used now by help-for-help. Add binding to continue text searches. Expand index searches to work over multiple info documents. Add commands to search text/index in User and Lispref. Add new entry, "Uncomment Region" (parallels "Comment Out Region"). Redo Help menu; add bindings for new Info commands to search the index or text of the User and Lispref manuals. Add command for mark-paragraph, activate-region. Make Edit->R accelerator be rectangle, not register (more commonly used), and put rectangle first. Fix the Edit Init File entry to never load the .elc file. Simplify the default-popup-menu. Add Cmds->Tabs menu. Use kp-left not kp_left, etc. ---------------- Miscellaneous bug fixes/cleanup ------------------- byte-compiler-options: Correct doc string. easy-menu-do-define: fix extra quote. fill-paragraph-or-region:Rewrite to be more correct -- use call-interactively so that we always get exactly the same behavior as if the functions were called directly. No need to fiddle with zmacs-region-stays, now that bogus clearing of it (2001-04-28 src/ChangeLog) is removed. Put dialog titles back in -- this time correctly. Fix various other problems with leaks and such. key-sequence-list-description: Clean up fun to always correctly canonicalize. Clean up Kinsoku comments, synch comment-region with FSF 20.7. * simple.el (region-exists-p): * simple.el (region-active-p): Add comment about which one is correct to use in menu specs. * sound.el (load-sound-file): Minor code clean up. * startup.el: * startup.el (command-line-early): * startup.el (initial-scratch-message): Comment changes. Add info about sample.init.el to splash screen. Improve initial-scratch-message and clarify purpose of Scratch buffer. Fix byte-compile warning. ------------------------ Added features ------------------------- Add new variable to control whether etags checks all parent directories for tag files. (On by default.) * hash-table.el: New file, useful utility functions. * dumped-lisp.el (preloaded-file-list): Dump hash-table.el. ------------ notable bug fix: Windows event code -------------- Get critical quit working. ------------ notable bug fix and new feature: regex code -------------- Shy groups were implemented in a horrible, half-assed way that would cause them to screw up regex searching in most cases. Fixed to work correctly. Also extended back-reference syntax past 9. Only is recognized as such if there are at least that many non-shy groups; and optionally will warn about such uses, to catch old code that might be using them differently. (Added variable to control this in search.c -- `warn-about-possibly-incompatible-back- references', on by default for the moment. Declared in lisp.h. ---------------- process/SIGIO improvements ------------------- define USE_GETADDRINFO to replace more complex conditional, and use it. the code conditionalized on this in unix_open_network_stream had *serious* problems handling errors. it's now fixed, and major amounts of duplicate code between the two versions were combined. don't disable SIGIO and other interrupts unless CONNECT_NEEDS_SLOWED_INTERRUPTS is defined -- don't penalize OS's without bugs. similarly for a freebsd bug that was affecting all OS's. * s\ultrix.h: define CONNECT_NEEDS_SLOWED_INTERRUPTS, since that's the OS mentioned as having a kernel bug. * sysdep.c (request_sigio_on_device): * sysdep.c (unrequest_sigio_on_device): fix SIGIO problems on Linux. add check for O_ASYNC in case it's defined and FASYNC isn't. add comment about other ways to do SIGIO on Linux. * callproc.c (Fold_call_process_internal): * process.c (Fstart_process_internal): Deal with the possibility that `default-directory' doesn't have terminating slash. Correct comments about vfork. ---------------- Miscellaneous bug fixes/cleanup ------------------- * callint.c (Finteractive): Add lots of documentation -- exactly what the Lisp equivalents of all the interactive specs are. * console.h (struct console): change type of quit_char to Emchar. * event-msw.c (lstream_type_create_mswindows_selectable): spacing change. Eliminate events-mod.h and combine into events.h. * emacs.c: * emacs.c (make_arg_list_1): * emacs.c (main_1): A couple of char->Extbyte changes, add a comment. * glyphs-msw.c: Correct indentation of function defns to not exceed 80 cols. Try (sort of) to fix some code that sets the colors of the progress gauge. (Commented out) * keymap.c (syms_of_keymap): use DEFSYMBOL. * process.c (read_process_output): No need to fiddle with zmacs_region_stays, now that bogus clearing of it (see below) is removed. * search.c (Freplace_match): warning fix.
author ben
date Fri, 04 May 2001 22:42:35 +0000
parents 576fb035e263
children 29e4e3036b4e
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)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (define-key map [button2] 'hyper-apropos-mouse-get-doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (define-key map [button3] 'hyper-apropos-popup-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 ;; for the totally hardcore...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (define-key map "D" 'hyper-apropos-disassemble)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 ;; administrativa
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (define-key map "a" 'hyper-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (define-key map "n" 'hyper-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (define-key map "q" 'hyper-apropos-quit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 "Keybindings for the *Hyper Help* buffer and the *Hyper Apropos* buffer")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (define-obsolete-variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 'hypropos-help-map 'hyper-apropos-help-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (defvar hyper-apropos-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (let ((map (make-sparse-keymap)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (set-keymap-name map 'hyper-apropos-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (set-keymap-parents map (list hyper-apropos-help-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ;; slightly different scrolling...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (define-key map " " 'hyper-apropos-scroll-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (define-key map "b" 'hyper-apropos-scroll-down)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (define-key map [delete] 'hyper-apropos-scroll-down)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (define-key map [backspace] 'hyper-apropos-scroll-down)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 ;; act on the current line...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (define-key map "w" 'hyper-apropos-where-is)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (define-key map "i" 'hyper-apropos-invoke-fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 ;; this is already defined in the parent-keymap above, isn't it?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 ;; (define-key map "s" 'hyper-apropos-set-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 ;; more administrativa...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (define-key map "P" 'hyper-apropos-toggle-programming-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (define-key map "k" 'hyper-apropos-add-keyword)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (define-key map "e" 'hyper-apropos-eliminate-keyword)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 "Keybindings for the *Hyper Apropos* buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 This map inherits from `hyper-apropos-help-map.'")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (define-obsolete-variable-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 'hypropos-map 'hyper-apropos-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 ;;(defvar hyper-apropos-mousable-keymap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 ;; (let ((map (make-sparse-keymap)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 ;; (define-key map [button2] 'hyper-apropos-mouse-get-doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 ;; map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (defvar hyper-apropos-mode-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 "*User function run after hyper-apropos mode initialization. Usage:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 \(add-hook 'hyper-apropos-mode-hook #'(lambda () ... your init forms ...)).")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
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 (defconst hyper-apropos-junk-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 "^Apropos\\|^Functions\\|^Variables\\|^$")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (defvar hyper-apropos-currently-showing nil) ; symbol documented in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 ; help buffer now
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (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
231 ; help buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (defvar hyper-apropos-face-history nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 ;;;(defvar hyper-apropos-variable-history nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 ;;;(defvar hyper-apropos-function-history nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (defvar hyper-apropos-regexp-history nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (defvar hyper-apropos-last-regexp nil) ; regex used for last apropos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (defconst hyper-apropos-apropos-buf "*Hyper Apropos*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (defconst hyper-apropos-help-buf "*Hyper Help*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 ;;;###autoload
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
241 (defun command-hyper-apropos (regexp)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
242 "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
243 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
244 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
245 (interactive (list (read-from-minibuffer
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
246 "List symbols matching regexp: "
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
247 nil nil nil 'hyper-apropos-regexp-history)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
248 (let ((hyper-apropos-programming-apropos nil))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
249 (hyper-apropos regexp nil)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
250
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
251 ;;;###autoload
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (defun hyper-apropos (regexp toggle-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 "Display lists of functions and variables matching REGEXP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 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
256 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
257 a Hyper-Apropos buffer."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
258 (interactive (list (read-from-minibuffer
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
259 "List symbols matching regexp: "
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
260 nil nil nil 'hyper-apropos-regexp-history)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (if (string= "" regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (if (get-buffer hyper-apropos-apropos-buf)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
266 (progn
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
267 (setq regexp hyper-apropos-last-regexp)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
268 (if toggle-apropos
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
269 (hyper-apropos-toggle-programming-flag)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
270 (message "Using last search results")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (error "Be more specific..."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (set-buffer (get-buffer-create hyper-apropos-apropos-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (if toggle-apropos
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
276 (if (local-variable-p 'hyper-apropos-programming-apropos
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
277 (current-buffer))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
278 (setq hyper-apropos-programming-apropos
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
279 (not hyper-apropos-programming-apropos))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
280 (set (make-local-variable 'hyper-apropos-programming-apropos)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
281 (not (default-value 'hyper-apropos-programming-apropos)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (let ((flist (apropos-internal regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (if hyper-apropos-programming-apropos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 #'fboundp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 #'commandp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (vlist (apropos-internal regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (if hyper-apropos-programming-apropos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 #'boundp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 #'user-variable-p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (insert-face (format "Apropos search for: %S\n\n" regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 'hyper-apropos-major-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (insert-face "* = command (M-x) or user-variable.\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 'hyper-apropos-documentation)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (insert-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 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
296 'hyper-apropos-documentation)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (insert-face "Functions and Macros:\n\n" 'hyper-apropos-major-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (hyper-apropos-grok-functions flist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (insert-face "\n\nVariables and Constants:\n\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 'hyper-apropos-major-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (hyper-apropos-grok-variables vlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (goto-char (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (switch-to-buffer hyper-apropos-apropos-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (hyper-apropos-mode regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (defun hyper-apropos-toggle-programming-flag ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (with-current-buffer hyper-apropos-apropos-buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (set (make-local-variable 'hyper-apropos-programming-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (not hyper-apropos-programming-apropos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (message "Re-running apropos...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (hyper-apropos hyper-apropos-last-regexp nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (defun hyper-apropos-grok-functions (fns)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (let (bind doc type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (dolist (fn fns)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (setq bind (symbol-function fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 type (cond ((subrp bind) ?i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 ((compiled-function-p bind) ?b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ((consp bind) (or (cdr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (assq (car bind) '((autoload . ?a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (lambda . ?l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (macro . ?m))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 ??))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (t ?\ )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (insert type (if (commandp fn) "* " " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (set-extent-property e 'mouse-face 'highlight))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (insert-char ?\ (let ((l (- 30 (length (format "%S" fn)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (if (natnump l) l 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (and hyper-apropos-show-brief-docs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (setq doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 ;; A symbol's function slot can point to an unbound symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ;; In that case, `documentation' will fail.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (ignore-errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (documentation fn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (if (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 "^([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (setq doc (substring doc (match-end 0) (string-match "\n" doc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (insert-face (if doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (concat " - "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (substring doc 0 (string-match "\n" doc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 " Not documented.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 'hyper-apropos-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (insert ?\n))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (defun hyper-apropos-grok-variables (vars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (let (doc userp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (dolist (var vars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (setq userp (user-variable-p var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (insert (if userp " * " " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (set-extent-property e 'mouse-face 'highlight))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (insert-char ?\ (let ((l (- 30 (length (format "%S" var)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (if (natnump l) l 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (and hyper-apropos-show-brief-docs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (setq doc (documentation-property var 'variable-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (insert-face (if doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (concat " - " (substring doc (if userp 1 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (string-match "\n" doc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 " - Not documented.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 'hyper-apropos-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (insert ?\n))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
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 (defun hyper-apropos-mode (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 "Improved apropos mode for displaying Emacs documentation. Function and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 variable names are displayed in the buffer \"*Hyper Apropos*\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 Functions are preceded by a single character to indicates their types:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 Interactive functions are also preceded by an asterisk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Variables are preceded by an asterisk if they are user variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 General Commands:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 SPC - scroll documentation or apropos window forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 b - scroll documentation or apropos window backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 k - eliminate all hits that don't contain keyword
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 n - new search
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 / - isearch-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 q - quit and restore previous window configuration
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 Operations for Symbol on Current Line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 RET - toggle display of symbol's documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (also on button2 in xemacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 w - show the keybinding if symbol is a command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 i - invoke function on current line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 s - set value of variable on current line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 t - display the C or lisp source (find-tag)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (delete-other-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (setq mode-name "Hyper-Apropos"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 major-mode 'hyper-apropos-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 buffer-read-only t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 truncate-lines t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 hyper-apropos-last-regexp regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 modeline-buffer-identification
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (list (cons modeline-buffer-id-left-extent "Hyper Apropos: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (cons modeline-buffer-id-right-extent (concat "\"" regexp "\""))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (use-local-map hyper-apropos-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (run-hooks 'hyper-apropos-mode-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 ;; ---------------------------------------------------------------------- ;;
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 ;; similar to `describe-key-briefly', copied from help.el by CW
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (defun hyper-describe-key (key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (interactive "kDescribe key: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (hyper-describe-key-briefly key t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (defun hyper-describe-key-briefly (key &optional show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (interactive "kDescribe key briefly: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (let (menup defn interm final msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (setq defn (key-or-menu-binding key 'menup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (if (or (null defn) (integerp defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (or (numberp show) (message "%s is undefined" (key-description key)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (cond ((stringp defn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (setq interm defn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 final (key-binding defn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 ((vectorp defn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (setq interm (append defn nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (while (and interm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (member (key-binding (vector (car interm)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 '(universal-argument digit-argument)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (setq interm (cdr interm)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (while (and interm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (not (setq final (key-binding (vconcat interm)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (setq interm (butlast interm)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (if final
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (setq interm (vconcat interm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (setq interm defn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 final (key-binding defn)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (setq msg (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 "%s runs %s%s%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 ;; This used to say 'This menu item' but it could also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 ;; be a scrollbar event. We can't distinguish at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 ;; moment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (if menup "This item" (key-description key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 ;;(if (symbolp defn) defn (key-description defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (if (symbolp defn) defn (prin1-to-string defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (if final (concat ", " (key-description interm) " runs ") "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (if final
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (if (symbolp final) final (prin1-to-string final))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (if (numberp show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (or (not (symbolp defn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (memq (symbol-function defn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 '(zkey-init-kbd-macro zkey-init-kbd-fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (progn (princ msg) (princ "\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (message "%s" msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (if final (setq defn final))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 defn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 show)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
461 (hyper-apropos-get-doc defn t))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
462 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
463 (setq hyper-apropos-prev-wconfig (current-window-configuration)))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (defun hyper-describe-face (symbol &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 "Describe face..
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 See also `hyper-apropos' and `hyper-describe-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (let (v val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (setq v (hyper-apropos-this-symbol)) ; symbol under point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (or (find-face v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (setq v (variable-at-point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (setq val (let ((enable-recursive-minibuffers t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (concat (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 "Follow face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 "Describe face")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (if v
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (format " (default %s): " v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 ": "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (mapcar #'(lambda (x) (list (symbol-name x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (face-list))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
485 nil t nil 'hyper-apropos-face-history
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
486 (and v (symbol-name v)))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
487 (list (intern-soft val)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (defun hyper-describe-variable (symbol &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 "Hypertext drop-in replacement for `describe-variable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 See also `hyper-apropos' and `hyper-describe-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (interactive (list (hyper-apropos-read-variable-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 "Follow variable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 "Describe variable"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (defun hyper-where-is (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 "Print message listing key sequences that invoke specified command."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (interactive (list (hyper-apropos-read-function-symbol "Where is function")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (where-is symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (defun hyper-describe-function (symbol &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 "Hypertext replacement for `describe-function'. Unlike `describe-function'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 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
523 See also `hyper-apropos' and `hyper-describe-variable'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (interactive (list (hyper-apropos-read-function-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 "Follow function"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 "Describe function"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (if (null symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (message "Sorry, nothing to describe.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (hyper-apropos-get-doc symbol t nil this-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (defun hyper-apropos-read-variable-symbol (prompt &optional predicate)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 "Hypertext drop-in replacement for `describe-variable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 See also `hyper-apropos' and `hyper-describe-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 ;; #### - perhaps a prefix arg should suppress the prompt...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (or predicate (setq predicate 'boundp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (let (v val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (setq v (hyper-apropos-this-symbol)) ; symbol under point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (or (funcall predicate v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (setq v (variable-at-point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (or (funcall predicate v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (setq v nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (setq val (let ((enable-recursive-minibuffers t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (concat prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (if v
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (format " (default %s): " v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 ": "))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
554 obarray predicate t nil 'variable-history
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
555 (and v (symbol-name v)))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
556 (intern-soft val)))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
557
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (defun hyper-apropos-read-function-symbol (prompt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 "Read function symbol from minibuffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (let ((fn (hyper-apropos-this-symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (or (fboundp fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (setq fn (function-at-point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (setq val (let ((enable-recursive-minibuffers t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (completing-read (if fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (format "%s (default %s): " prompt fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (format "%s: " prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 obarray 'fboundp t nil
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
573 'function-history
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
574 (and fn (symbol-name fn)))))
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
575 (intern-soft val)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (defun hyper-apropos-last-help (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 "Go back to the last symbol documented in the *Hyper Help* buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (let ((win (get-buffer-window hyper-apropos-help-buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (or arg (setq arg (if win 1 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (cond ((= arg 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ((<= (length hyper-apropos-help-history) arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ;; go back as far as we can...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 (setcdr (nreverse hyper-apropos-help-history) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (setq hyper-apropos-help-history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (nthcdr arg hyper-apropos-help-history))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (if (or win (> arg 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (hyper-apropos-get-doc (car hyper-apropos-help-history) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (display-buffer hyper-apropos-help-buf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (defun hyper-apropos-insert-face (string &optional face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 "Insert STRING and fontify some parts with face `hyper-apropos-hyperlink'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (let ((beg (point)) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (insert-face string (or face 'hyper-apropos-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (setq end (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (goto-char beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (while (re-search-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 "`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 end 'limit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (let ((e (make-extent (match-beginning 1) (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (set-extent-face e 'hyper-apropos-hyperlink)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (set-extent-property e 'mouse-face 'highlight)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (goto-char beg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (while (re-search-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 "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
608 end 'limit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (let ((e (make-extent (match-beginning 1) (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (set-extent-face e 'hyper-apropos-hyperlink)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (set-extent-property e 'mouse-face 'highlight)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (defun hyper-apropos-insert-keybinding (keys string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (if keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (insert " (" string " bound to \""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (mapconcat 'key-description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (sort* keys #'< :key #'length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 "\", \"")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 "\")\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (defun hyper-apropos-insert-section-heading (alias-desc &optional desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (or desc (setq desc alias-desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 alias-desc nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (if alias-desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (setq desc (concat alias-desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (if (memq (aref desc 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 '(?a ?e ?i ?o ?u))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 ", an " ", a ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 desc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (aset desc 0 (upcase (aref desc 0))) ; capitalize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (newline 3) (delete-blank-lines) (newline 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (hyper-apropos-insert-face desc 'hyper-apropos-section-heading))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (defun hyper-apropos-insert-value (string symbol val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (insert-face string 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (insert (if (symbol-value symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (if (or (null val) (eq val t) (integerp val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (symbol-value symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 (set symbol nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 "see below")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 "is void")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (defun hyper-apropos-follow-ref-buffer (this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (and (not this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (eq major-mode 'hyper-apropos-help-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 hyper-apropos-ref-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (buffer-live-p hyper-apropos-ref-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (defun hyper-apropos-get-alias (symbol alias-p next-symbol &optional use)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 "Return (TERMINAL-SYMBOL . ALIAS-DESC)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (let (aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (while (funcall alias-p symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (setq aliases (cons (if use (funcall use symbol) symbol) aliases))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (setq symbol (funcall next-symbol symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (cons symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (and aliases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (concat "an alias for `"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (mapconcat 'symbol-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (nreverse aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 "',\nwhich is an alias for `")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 "'")))))
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 (defun hyper-apropos-get-doc (&optional symbol force type this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 ;; #### - update this docstring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 "Toggle display of documentation for the symbol on the current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ;; SYMBOL is the symbol to document. FORCE, if non-nil, means to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;; regenerate the documentation even if it already seems to be there. And
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ;; TYPE, if present, forces the generation of only variable documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 ;; or only function documentation. Normally, if both are present, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 ;; both will be generated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 ;; TYPES TO IMPLEMENT: obsolete face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (or symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (setq symbol (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (or type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (setq type '(function variable face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (if (and (eq hyper-apropos-currently-showing symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (get-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (get-buffer-window hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (not force))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 ;; we're already displaying this help, so toggle its display.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (delete-windows-on hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 ;; OK, we've got to refresh and display it...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (or (eq symbol (car hyper-apropos-help-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (setq hyper-apropos-help-history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (if (eq major-mode 'hyper-apropos-help-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 ;; if we're following a link in the help buffer, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;; record that in the help history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (cons symbol hyper-apropos-help-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 ;; otherwise clear the history because it's a new search.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (list symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (set-buffer hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (setq hyper-apropos-ref-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (let (standard-output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 ok beg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 newsym symtype doc obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (local mode-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 global local-str global-str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 font fore back undl
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 aliases alias-desc desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (set-buffer (get-buffer-create hyper-apropos-help-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 ;;(setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (insert-face (format "`%s'" symbol) 'hyper-apropos-major-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (insert (format " (buffer: %s, mode: %s)\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (buffer-name hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 local)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 ;; function ----------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 (and (memq 'function type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (fboundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (setq ok t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (setq aliases (hyper-apropos-get-alias (symbol-function symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 'symbolp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 'symbol-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 newsym (car aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 alias-desc (cdr aliases))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (if (eq 'macro (car-safe newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 (setq desc "macro"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 newsym (cdr newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (setq desc "function"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (setq symtype (cond ((subrp newsym) 'subr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 ((compiled-function-p newsym) 'bytecode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ((eq (car-safe newsym) 'autoload) 'autoload)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 ((eq (car-safe newsym) 'lambda) 'lambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 desc (concat (if (commandp symbol) "interactive ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 (cdr (assq symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 '((subr . "built-in ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 (bytecode . "compiled Lisp ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (autoload . "autoloaded Lisp ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (lambda . "Lisp "))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 desc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 (case symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 ((autoload) (format ",\n(autoloaded from \"%s\")"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (nth 1 newsym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 ((bytecode) (format ",\n(loaded from \"%s\")"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (symbol-file symbol)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 local (current-local-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 global (current-global-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 obsolete (get symbol 'byte-obsolete-info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 doc (or (documentation symbol) "function not documented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (hyper-apropos-insert-section-heading alias-desc desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (insert ":\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (if local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (hyper-apropos-insert-keybinding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (where-is-internal symbol (list local) nil nil nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 "locally"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (hyper-apropos-insert-keybinding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (where-is-internal symbol (list global) nil nil nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 "globally")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (if obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (hyper-apropos-insert-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (format "%s is an obsolete function; %s\n\n" symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (if (stringp (car obsolete))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (car obsolete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (format "use `%s' instead." (car obsolete))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 'hyper-apropos-warning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (setq beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (insert-face "arguments: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (cond ((eq symtype 'lambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (princ (or (nth 1 newsym) "()")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 ((eq symtype 'bytecode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (princ (or (compiled-function-arglist newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 "()")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 ((and (eq symtype 'subr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (insert (substring doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (match-end 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (setq doc (substring doc 0 (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 ((and (eq symtype 'subr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 \[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (insert "("
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (if (match-end 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (substring doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (match-end 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 (setq doc (substring doc (match-end 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (t (princ "[not available]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (insert "\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 (hyper-apropos-insert-face doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (indent-rigidly beg (point) 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 ;; variable ----------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 (and (memq 'variable type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 (or (boundp symbol) (default-boundp symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (setq ok t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 (setq aliases (hyper-apropos-get-alias symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 'variable-alias
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 newsym (car aliases)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 alias-desc (cdr aliases))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 (setq symtype (or (local-variable-p newsym (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (and (local-variable-p newsym
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 (current-buffer) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 'auto-local))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 desc (concat (and (get newsym 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 "customizable ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (if (user-variable-p newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 "user variable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 "variable")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 (cond ((eq symtype t) ", buffer-local")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 ((eq symtype 'auto-local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 ", local when set")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 local (and (boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (symbol-value newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 local-str (and (boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 (prin1-to-string local))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 global (and (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (default-boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (default-value newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 global-str (and (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 (default-boundp newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 (prin1-to-string global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 obsolete (get symbol 'byte-obsolete-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 doc (or (documentation-property symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 'variable-documentation)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 "variable not documented"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 (hyper-apropos-insert-section-heading alias-desc desc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (when (and (user-variable-p newsym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (get newsym 'custom-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (let ((e (make-extent (point-at-bol) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 (set-extent-property e 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (set-extent-property e 'help-echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (format "Customize %s" newsym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 (set-extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 e 'hyper-apropos-custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 `(lambda () (customize-variable (quote ,newsym))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 (insert ":\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (setq beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (if obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 (hyper-apropos-insert-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 (format "%s is an obsolete function; %s\n\n" symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 (if (stringp obsolete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 obsolete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (format "use `%s' instead." obsolete)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 'hyper-apropos-warning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 ;; generally, the value of the variable is short and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 ;; documentation of the variable long, so it's desirable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 ;; to see all of the value and the start of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 ;; documentation. Some variables, though, have huge and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 ;; nearly meaningless values that force you to page
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 ;; forward just to find the doc string. That is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 ;; undesirable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 (if (and (or (null local-str) (< (length local-str) 69))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 (or (null global-str) (< (length global-str) 69)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 ; 80 cols. docstrings assume this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 (progn (insert-face "value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (insert (or local-str "is void"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 (if (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (insert-face "default value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 (insert (or global-str "is void"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (insert "\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (hyper-apropos-insert-face doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (hyper-apropos-insert-value "value: " 'local-str local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 (if (eq symtype t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 (insert ", ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 (hyper-apropos-insert-value "default-value: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 'global-str global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 (insert "\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 (hyper-apropos-insert-face doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (if local-str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 (newline 3) (delete-blank-lines) (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (insert-face "value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 (if hyper-apropos-prettyprint-long-values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (cl-prettyprint local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (error (insert local-str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (insert local-str))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (if global-str
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (newline 3) (delete-blank-lines) (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 (insert-face "default value: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 (if hyper-apropos-prettyprint-long-values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (cl-prettyprint global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (error (insert global-str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (insert global-str)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 (indent-rigidly beg (point) 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 ;; face --------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 (and (memq 'face type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (find-face symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 (setq ok t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 (copy-face symbol 'hyper-apropos-temp-face 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 (mapcar #'(lambda (property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 (setq symtype (face-property-instance symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 (if symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (set-face-property 'hyper-apropos-temp-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 symtype)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (setq font (cons (face-property-instance symbol 'font nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (face-property-instance symbol 'font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 fore (cons (face-foreground-instance symbol nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 (face-foreground-instance symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 back (cons (face-background-instance symbol nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 (face-background-instance symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 undl (cons (face-underline-p symbol nil 0 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (face-underline-p symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 doc (face-doc-string symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 ;; #### - add some code here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 (hyper-apropos-insert-section-heading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (concat "Face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 (when (get symbol 'face-defface-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 (let* ((str " (customizable)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 (e (make-extent 1 (length str) str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 (set-extent-property e 'mouse-face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 (set-extent-property e 'help-echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 (format "Customize %s" symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (set-extent-property e 'unique t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 (set-extent-property e 'duplicable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 (set-extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 e 'hyper-apropos-custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 `(lambda () (customize-face (quote ,symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 ":\n\n "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (insert-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 ABCDEFHIJKLMNOPQRSTUVWXYZ abcdefhijklmnopqrstuvwxyz 0123456789"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 'hyper-apropos-temp-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 (newline 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 (insert-face " Font: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (insert (format (if (numberp (car font)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (and (cdr font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (font-instance-name (cdr font)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 (insert-face " Foreground: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 (insert (format (if (numberp (car fore)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 (and (cdr fore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 (color-instance-name (cdr fore)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 (insert-face " Background: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 (insert (format (if (numberp (car back)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 (and (cdr back)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (color-instance-name (cdr back)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 (insert-face " Underline: " 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 (insert (format (if (numberp (car undl)) "(%s)\n" "%s\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (cdr undl)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 (if doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 (newline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (setq beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (insert doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 (indent-rigidly beg (point) 2))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 ;; not bound & property list -----------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 (or ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 (hyper-apropos-insert-section-heading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 "symbol is not currently bound\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 (if (and (setq symtype (symbol-plist symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (or (> (length symtype) 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 (not (memq 'variable-documentation symtype))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 (setq standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 (hyper-apropos-insert-section-heading "property-list:\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 (while symtype
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 (if (memq (car symtype)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 '(variable-documentation byte-obsolete-info))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 (setq symtype (cdr symtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 (insert-face (concat " " (symbol-name (car symtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 'hyper-apropos-heading)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 (setq symtype (cdr symtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 (indent-to 32)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 (insert (prin1-to-string (car symtype)) "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (setq symtype (cdr symtype)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 (set-buffer hyper-apropos-help-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 ;; pop up window and shrink it if it's wasting space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 (if hyper-apropos-shrink-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (shrink-window-if-larger-than-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 (display-buffer (current-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 (hyper-apropos-help-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (setq hyper-apropos-currently-showing symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 'hypropos-get-doc 'hyper-apropos-get-doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014
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 (defun hyper-apropos-help-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 "Major mode for hypertext XEmacs help. In this mode, you can quickly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 follow links between back and forth between the documentation strings for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 different variables and functions. Common commands:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 \\{hyper-apropos-help-map}"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 (setq buffer-read-only t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 major-mode 'hyper-apropos-help-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 mode-name "Hyper-Help")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 (set-syntax-table emacs-lisp-mode-syntax-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 (use-local-map hyper-apropos-help-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028
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 (defun hyper-apropos-scroll-up ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 "Scroll up the \"*Hyper Help*\" buffer if it's visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 Otherwise, scroll the selected window up."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 (let ((win (get-buffer-window hyper-apropos-help-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 (owin (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 (if win
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (select-window win)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 (scroll-up nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 (error (goto-char (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 (select-window owin))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 (scroll-up nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 (defun hyper-apropos-scroll-down ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 "Scroll down the \"*Hyper Help*\" buffer if it's visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 Otherwise, scroll the selected window down."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 (let ((win (get-buffer-window hyper-apropos-help-buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 (owin (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 (if win
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 (select-window win)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 (scroll-down nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 (error (goto-char (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (select-window owin))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 (scroll-down nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 (defun hyper-apropos-mouse-get-doc (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 "Get the documentation for the symbol the mouse is on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 (interactive "e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 (mouse-set-point event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 (let ((e (extent-at (point) nil 'hyper-apropos-custom)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 (if e
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 (funcall (extent-property e 'hyper-apropos-custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (let ((symbol (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (if symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (hyper-apropos-get-doc symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 (error "Click on a symbol")))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075
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 (defun hyper-apropos-add-keyword (pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 "Use additional keyword to narrow regexp match.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 Deletes lines which don't match PATTERN."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 (interactive "sAdditional Keyword: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 (let (buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (keep-lines (concat pattern "\\|" hyper-apropos-junk-regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 )))
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 (defun hyper-apropos-eliminate-keyword (pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 "Use additional keyword to eliminate uninteresting matches.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 Deletes lines which match PATTERN."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 (interactive "sKeyword to eliminate: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (let (buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 (flush-lines pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 ))
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 (defun hyper-apropos-this-symbol ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 (cond ((eq major-mode 'hyper-apropos-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (if (looking-at hyper-apropos-junk-regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 (forward-char 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 (read (point-marker))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1108 ;; 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
1109 ;; ((and
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1110 ;; (eq major-mode 'hyper-apropos-help-mode)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1111 ;; (> (point) (point-min)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1112 ;; (save-excursion
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1113 ;; (goto-char (point-min))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 440
diff changeset
1114 ;; (hyper-apropos-this-symbol)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (let* ((st (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (skip-syntax-backward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 ;; !@(*$^%%# stupid backquote implementation!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 (skip-chars-forward "`")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 (en (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 (skip-syntax-forward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (skip-chars-backward ".':") ; : for Local Variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 (and (not (eq st en))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 (intern-soft (buffer-substring st en))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 (defun hyper-apropos-where-is (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 "Find keybinding for symbol on current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 (where-is symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 (defun hyper-apropos-invoke-fn (fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 "Interactively invoke the function on the current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 (cond ((not (fboundp fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 (error "%S is not a function" fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 (t (call-interactively fn))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 (defun hyper-set-variable (var val &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 (let ((var (hyper-apropos-read-variable-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 (if (hyper-apropos-follow-ref-buffer current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 "In ref buffer, set user option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 "Set user option")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 'user-variable-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 (list var (hyper-apropos-read-variable-value var) current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 (hyper-apropos-set-variable var val this-ref-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 "Interactively set the variable on the current line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 (let ((var (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 (or (and var (boundp var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 (setq var nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 (list var (hyper-apropos-read-variable-value var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 (and var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 (set-buffer hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 (set var val))
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 (hyper-apropos-get-doc var t '(variable) this-ref-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 'hypropos-set-variable 'hyper-apropos-set-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 (defun hyper-apropos-read-variable-value (var &optional this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 (and var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 (let ((prop (get var 'variable-interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 (print-readably t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 val str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 (hyper-apropos-get-doc var t '(variable) current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 (if prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 (call-interactively (list 'lambda '(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 (list 'interactive prop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 'arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 (setq val (if (hyper-apropos-follow-ref-buffer this-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 (set-buffer hyper-apropos-ref-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 (symbol-value var))
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 str (prin1-to-string val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 (eval-minibuffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 (format "Set %s `%s' to value (evaluated): "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 (if (user-variable-p var) "user option" "Variable")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 (read str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 (format (if (or (consp val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 (and (symbolp val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 (not (memq val '(t nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 "'%s" "%s")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 (error nil)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 (defun hyper-apropos-customize-variable ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 (let ((var (hyper-apropos-this-symbol)))
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1206 (and
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1207 (or (and var (boundp var))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1208 (setq var nil))
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1209 (customize-variable var))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210
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 (defun hyper-apropos-find-tag (&optional tag-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 "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
1215 order for this to work properly, the variable `tag-table-alist' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 `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
1217 source is found for the \"*Hyper Apropos*\" buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 ;; there ought to be a default tags file for this...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 (or tag-name (setq tag-name (symbol-name (hyper-apropos-this-symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 (find-tag-other-window (list tag-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222
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 (defun hyper-apropos-find-function (fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 "Find the function for the symbol on the current line in other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 window. (See also `find-function'.)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 (let ((fn (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 (or (fboundp fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 (setq fn nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 (list fn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 (if fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 (find-function-other-window fn)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 (defun hyper-apropos-disassemble (sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 "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
1240 (interactive (list (hyper-apropos-this-symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 (let ((fun sym) (trail nil) macrop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 (while (and (symbolp fun) (not (memq fun trail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 (setq trail (cons fun trail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 fun (symbol-function fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 (and (symbolp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 (error "Loop detected in function binding of `%s'" fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 (setq macrop (and (consp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 (eq 'macro (car fun))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 (cond ((compiled-function-p (if macrop (cdr fun) fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 (disassemble fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 (set-buffer "*Disassemble*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 (forward-sexp 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 (insert (format " for function `%S'" sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 ((consp fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 (with-current-buffer "*Disassemble*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 (cl-prettyprint (if macrop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 (cons 'defmacro (cons sym (cdr (cdr fun))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 (cons 'defun (cons sym (cdr fun))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 (set-buffer "*Disassemble*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (emacs-lisp-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 ((or (vectorp fun) (stringp fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 ;; #### - do something fancy here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 (with-output-to-temp-buffer "*Disassemble*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 (princ (format "%s is a keyboard macro:\n\n\t" sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 (prin1 fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 (error "Sorry, cannot disassemble `%s'" sym)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 (defun hyper-apropos-quit ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 "Quit Hyper Apropos and restore original window config."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 (let ((buf (get-buffer hyper-apropos-apropos-buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 (and buf (bury-buffer buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 (set-window-configuration hyper-apropos-prev-wconfig))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 ;; ---------------------------------------------------------------------- ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 (defun hyper-apropos-popup-menu (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 (interactive "e")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 (mouse-set-point event)
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1286 (let* ((sym (hyper-apropos-this-symbol))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 (notjunk (not (null sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 (command-p (if (commandp sym) t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (variable-p (and sym (boundp sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 (customizable-p (and variable-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 (get sym 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 (function-p (fboundp sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 (apropos-p (eq 'hyper-apropos-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 (save-excursion (set-buffer (event-buffer event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 major-mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 (name (if sym (symbol-name sym) ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 (hyper-apropos-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 (delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 (list (concat "Hyper-Help: " name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 (vector "Display documentation" 'hyper-apropos-get-doc notjunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 (vector "Set variable" 'hyper-apropos-set-variable variable-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 (vector "Customize variable" 'hyper-apropos-customize-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 customizable-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 (vector "Show keys for" 'hyper-apropos-where-is command-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 (vector "Invoke command" 'hyper-apropos-invoke-fn command-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 (vector "Find function" 'hyper-apropos-find-function function-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 (vector "Find tag" 'hyper-apropos-find-tag notjunk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 (and apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 ["Add keyword..." hyper-apropos-add-keyword t])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 (and apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 ["Eliminate keyword..." hyper-apropos-eliminate-keyword t])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (if apropos-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 ["Programmers' Apropos" hyper-apropos-toggle-programming-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 :style toggle :selected hyper-apropos-programming-apropos]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 ["Programmers' Help" hyper-apropos-toggle-programming-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 :style toggle :selected hyper-apropos-programming-apropos])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (and hyper-apropos-programming-apropos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 (vector "Disassemble function"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 'hyper-apropos-disassemble
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 function-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 ["Help" describe-mode t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 ["Quit" hyper-apropos-quit t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 (popup-menu hyper-apropos-menu)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 (define-obsolete-function-alias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 'hypropos-popup-menu 'hyper-apropos-popup-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (provide 'hyper-apropos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 ;; end of hyper-apropos.el