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