Mercurial > hg > xemacs-beta

comparison lisp/hyper-apropos.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents bbff43aa5eb7
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
56 ;; added support for function aliases, made programmer's apropos be the 56 ;; added support for function aliases, made programmer's apropos be the
57 ;; default, various other hacking. 57 ;; default, various other hacking.
58 ;; Massive changes by Christoph Wedler <wedler@fmi.uni-passau.de> 58 ;; Massive changes by Christoph Wedler <wedler@fmi.uni-passau.de>
59 ;; Some changes for XEmacs 20.3 by hniksic 59 ;; Some changes for XEmacs 20.3 by hniksic
60 60
61 ;; ### The maintainer is supposed to be stig, but I haven't seen him 61 ;; #### The maintainer is supposed to be stig, but I haven't seen him
62 ;; around for ages. The real maintainer for the moment is Hrvoje 62 ;; around for ages. The real maintainer for the moment is Hrvoje
63 ;; Niksic <hniksic@srce.hr>. 63 ;; Niksic <hniksic@xemacs.org>.
64 64
65 ;;; Code: 65 ;;; Code:
66 66
67 (defgroup hyper-apropos nil 67 (defgroup hyper-apropos nil
68 "Hypertext emacs lisp documentation interface." 68 "Hypertext emacs lisp documentation interface."
241 current-prefix-arg)) 241 current-prefix-arg))
242 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) 242 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
243 (setq hyper-apropos-prev-wconfig (current-window-configuration))) 243 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
244 (if (string= "" regexp) 244 (if (string= "" regexp)
245 (if (get-buffer hyper-apropos-apropos-buf) 245 (if (get-buffer hyper-apropos-apropos-buf)
246 (if toggle-apropos 246 (progn
247 (hyper-apropos-toggle-programming-flag) 247 (setq regexp hyper-apropos-last-regexp)
248 (message "Using last search results")) 248 (if toggle-apropos
249 (hyper-apropos-toggle-programming-flag)
250 (message "Using last search results")))
249 (error "Be more specific...")) 251 (error "Be more specific..."))
250 (set-buffer (get-buffer-create hyper-apropos-apropos-buf)) 252 (set-buffer (get-buffer-create hyper-apropos-apropos-buf))
251 (setq buffer-read-only nil) 253 (setq buffer-read-only nil)
252 (erase-buffer) 254 (erase-buffer)
253 (if toggle-apropos 255 (if toggle-apropos
254 (set (make-local-variable 'hyper-apropos-programming-apropos) 256 (if (local-variable-p 'hyper-apropos-programming-apropos
255 (not (default-value 'hyper-apropos-programming-apropos)))) 257 (current-buffer))
258 (setq hyper-apropos-programming-apropos
259 (not hyper-apropos-programming-apropos))
260 (set (make-local-variable 'hyper-apropos-programming-apropos)
261 (not (default-value 'hyper-apropos-programming-apropos)))))
256 (let ((flist (apropos-internal regexp 262 (let ((flist (apropos-internal regexp
257 (if hyper-apropos-programming-apropos 263 (if hyper-apropos-programming-apropos
258 #'fboundp 264 #'fboundp
259 #'commandp))) 265 #'commandp)))
260 (vlist (apropos-internal regexp 266 (vlist (apropos-internal regexp
430 (message "%s" msg) 436 (message "%s" msg)
431 (if final (setq defn final)) 437 (if final (setq defn final))
432 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn)))) 438 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn))))
433 defn 439 defn
434 show) 440 show)
435 (hyper-apropos-get-doc defn t)))))) 441 (hyper-apropos-get-doc defn t))
442 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
443 (setq hyper-apropos-prev-wconfig (current-window-configuration)))))))
436 444
437 ;;;###autoload 445 ;;;###autoload
438 (defun hyper-describe-face (symbol &optional this-ref-buffer) 446 (defun hyper-describe-face (symbol &optional this-ref-buffer)
439 "Describe face.. 447 "Describe face..
440 See also `hyper-apropos' and `hyper-describe-function'." 448 See also `hyper-apropos' and `hyper-describe-function'."
452 (if v 460 (if v
453 (format " (default %s): " v) 461 (format " (default %s): " v)
454 ": ")) 462 ": "))
455 (mapcar #'(lambda (x) (list (symbol-name x))) 463 (mapcar #'(lambda (x) (list (symbol-name x)))
456 (face-list)) 464 (face-list))
457 nil t nil 'hyper-apropos-face-history))) 465 nil t nil 'hyper-apropos-face-history
458 (list (if (string= val "") 466 (and v (symbol-name v)))))
459 (progn (push (symbol-name v) hyper-apropos-face-history) v) 467 (list (intern-soft val)
460 (intern-soft val))
461 current-prefix-arg))) 468 current-prefix-arg)))
462 (if (null symbol) 469 (if (null symbol)
463 (message "Sorry, nothing to describe.") 470 (message "Sorry, nothing to describe.")
464 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) 471 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
465 (setq hyper-apropos-prev-wconfig (current-window-configuration))) 472 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
522 (completing-read 529 (completing-read
523 (concat prompt 530 (concat prompt
524 (if v 531 (if v
525 (format " (default %s): " v) 532 (format " (default %s): " v)
526 ": ")) 533 ": "))
527 obarray predicate t nil 'variable-history))) 534 obarray predicate t nil 'variable-history
528 (if (string= val "") 535 (and v (symbol-name v)))))
529 (progn (push (symbol-name v) variable-history) v) 536 (intern-soft val)))
530 (intern-soft val)))) 537
531 ;;;###autoload 538 ;;;###autoload
532 (define-obsolete-function-alias 539 (define-obsolete-function-alias
533 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol) 540 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol)
534 541
535 (defun hyper-apropos-read-function-symbol (prompt) 542 (defun hyper-apropos-read-function-symbol (prompt)
541 (setq val (let ((enable-recursive-minibuffers t)) 548 (setq val (let ((enable-recursive-minibuffers t))
542 (completing-read (if fn 549 (completing-read (if fn
543 (format "%s (default %s): " prompt fn) 550 (format "%s (default %s): " prompt fn)
544 (format "%s: " prompt)) 551 (format "%s: " prompt))
545 obarray 'fboundp t nil 552 obarray 'fboundp t nil
546 'function-history))) 553 'function-history
547 (if (equal val "") 554 (and fn (symbol-name fn)))))
548 (progn (push (symbol-name fn) function-history) fn) 555 (intern-soft val)))
549 (intern-soft val))))
550 556
551 (defun hyper-apropos-last-help (arg) 557 (defun hyper-apropos-last-help (arg)
552 "Go back to the last symbol documented in the *Hyper Help* buffer." 558 "Go back to the last symbol documented in the *Hyper Help* buffer."
553 (interactive "P") 559 (interactive "P")
554 (let ((win (get-buffer-window hyper-apropos-help-buf))) 560 (let ((win (get-buffer-window hyper-apropos-help-buf)))
1077 (beginning-of-line) 1083 (beginning-of-line)
1078 (if (looking-at hyper-apropos-junk-regexp) 1084 (if (looking-at hyper-apropos-junk-regexp)
1079 nil 1085 nil
1080 (forward-char 3) 1086 (forward-char 3)
1081 (read (point-marker)))) 1087 (read (point-marker))))
1088 ((and
1089 (eq major-mode 'hyper-apropos-help-mode)
1090 (> (point) (point-min)))
1091 (save-excursion
1092 (goto-char (point-min))
1093 (hyper-apropos-this-symbol)))
1082 (t 1094 (t
1083 (let* ((st (progn 1095 (let* ((st (progn
1084 (skip-syntax-backward "w_") 1096 (skip-syntax-backward "w_")
1085 ;; !@(*$^%%# stupid backquote implementation!!! 1097 ;; !@(*$^%%# stupid backquote implementation!!!
1086 (skip-chars-forward "`") 1098 (skip-chars-forward "`")
1119 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer) 1131 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer)
1120 "Interactively set the variable on the current line." 1132 "Interactively set the variable on the current line."
1121 (interactive 1133 (interactive
1122 (let ((var (hyper-apropos-this-symbol))) 1134 (let ((var (hyper-apropos-this-symbol)))
1123 (or (and var (boundp var)) 1135 (or (and var (boundp var))
1124 (and (setq var (and (eq major-mode 'hyper-apropos-help-mode)
1125 (save-excursion
1126 (goto-char (point-min))
1127 (hyper-apropos-this-symbol))))
1128 (boundp var))
1129 (setq var nil)) 1136 (setq var nil))
1130 (list var (hyper-apropos-read-variable-value var)))) 1137 (list var (hyper-apropos-read-variable-value var))))
1131 (and var 1138 (and var
1132 (boundp var) 1139 (boundp var)
1133 (progn 1140 (progn
1173 (error nil))))))) 1180 (error nil)))))))
1174 1181
1175 (defun hyper-apropos-customize-variable () 1182 (defun hyper-apropos-customize-variable ()
1176 (interactive) 1183 (interactive)
1177 (let ((var (hyper-apropos-this-symbol))) 1184 (let ((var (hyper-apropos-this-symbol)))
1178 (customize-variable var))) 1185 (and
1186 (or (and var (boundp var))
1187 (setq var nil))
1188 (customize-variable var))))
1179 1189
1180 ;; ---------------------------------------------------------------------- ;; 1190 ;; ---------------------------------------------------------------------- ;;
1181 1191
1182 (defun hyper-apropos-find-tag (&optional tag-name) 1192 (defun hyper-apropos-find-tag (&optional tag-name)
1183 "Find the tag for the symbol on the current line in other window. In 1193 "Find the tag for the symbol on the current line in other window. In
1195 "Find the function for the symbol on the current line in other 1205 "Find the function for the symbol on the current line in other
1196 window. (See also `find-function'.)" 1206 window. (See also `find-function'.)"
1197 (interactive 1207 (interactive
1198 (let ((fn (hyper-apropos-this-symbol))) 1208 (let ((fn (hyper-apropos-this-symbol)))
1199 (or (fboundp fn) 1209 (or (fboundp fn)
1200 (and (setq fn (and (eq major-mode 'hyper-apropos-help-mode)
1201 (save-excursion
1202 (goto-char (point-min))
1203 (hyper-apropos-this-symbol))))
1204 (fboundp fn))
1205 (setq fn nil)) 1210 (setq fn nil))
1206 (list fn))) 1211 (list fn)))
1207 (if fn 1212 (if fn
1208 (find-function-other-window fn))) 1213 (find-function-other-window fn)))
1209 1214
1255 1260
1256 ;;;###autoload 1261 ;;;###autoload
1257 (defun hyper-apropos-popup-menu (event) 1262 (defun hyper-apropos-popup-menu (event)
1258 (interactive "e") 1263 (interactive "e")
1259 (mouse-set-point event) 1264 (mouse-set-point event)
1260 (let* ((sym (or (hyper-apropos-this-symbol) 1265 (let* ((sym (hyper-apropos-this-symbol))
1261 (and (eq major-mode 'hyper-apropos-help-mode)
1262 (save-excursion
1263 (goto-char (point-min))
1264 (hyper-apropos-this-symbol)))))
1265 (notjunk (not (null sym))) 1266 (notjunk (not (null sym)))
1266 (command-p (if (commandp sym) t)) 1267 (command-p (if (commandp sym) t))
1267 (variable-p (and sym (boundp sym))) 1268 (variable-p (and sym (boundp sym)))
1268 (customizable-p (and variable-p 1269 (customizable-p (and variable-p
1269 (get sym 'custom-type) 1270 (get sym 'custom-type)