Mercurial > hg > xemacs-beta

comparison lisp/hyper-apropos.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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@xemacs.org>. 63 ;; Niksic <hniksic@srce.hr>.
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 (progn 246 (if toggle-apropos
247 (setq regexp hyper-apropos-last-regexp) 247 (hyper-apropos-toggle-programming-flag)
248 (if toggle-apropos 248 (message "Using last search results"))
249 (hyper-apropos-toggle-programming-flag)
250 (message "Using last search results")))
251 (error "Be more specific...")) 249 (error "Be more specific..."))
252 (set-buffer (get-buffer-create hyper-apropos-apropos-buf)) 250 (set-buffer (get-buffer-create hyper-apropos-apropos-buf))
253 (setq buffer-read-only nil) 251 (setq buffer-read-only nil)
254 (erase-buffer) 252 (erase-buffer)
255 (if toggle-apropos 253 (if toggle-apropos
256 (if (local-variable-p 'hyper-apropos-programming-apropos 254 (set (make-local-variable 'hyper-apropos-programming-apropos)
257 (current-buffer)) 255 (not (default-value 'hyper-apropos-programming-apropos))))
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)))))
262 (let ((flist (apropos-internal regexp 256 (let ((flist (apropos-internal regexp
263 (if hyper-apropos-programming-apropos 257 (if hyper-apropos-programming-apropos
264 #'fboundp 258 #'fboundp
265 #'commandp))) 259 #'commandp)))
266 (vlist (apropos-internal regexp 260 (vlist (apropos-internal regexp
436 (message "%s" msg) 430 (message "%s" msg)
437 (if final (setq defn final)) 431 (if final (setq defn final))
438 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn)))) 432 (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn))))
439 defn 433 defn
440 show) 434 show)
441 (hyper-apropos-get-doc defn t)) 435 (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)))))))
444 436
445 ;;;###autoload 437 ;;;###autoload
446 (defun hyper-describe-face (symbol &optional this-ref-buffer) 438 (defun hyper-describe-face (symbol &optional this-ref-buffer)
447 "Describe face.. 439 "Describe face..
448 See also `hyper-apropos' and `hyper-describe-function'." 440 See also `hyper-apropos' and `hyper-describe-function'."
460 (if v 452 (if v
461 (format " (default %s): " v) 453 (format " (default %s): " v)
462 ": ")) 454 ": "))
463 (mapcar #'(lambda (x) (list (symbol-name x))) 455 (mapcar #'(lambda (x) (list (symbol-name x)))
464 (face-list)) 456 (face-list))
465 nil t nil 'hyper-apropos-face-history 457 nil t nil 'hyper-apropos-face-history)))
466 (and v (symbol-name v))))) 458 (list (if (string= val "")
467 (list (intern-soft val) 459 (progn (push (symbol-name v) hyper-apropos-face-history) v)
460 (intern-soft val))
468 current-prefix-arg))) 461 current-prefix-arg)))
469 (if (null symbol) 462 (if (null symbol)
470 (message "Sorry, nothing to describe.") 463 (message "Sorry, nothing to describe.")
471 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) 464 (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode))
472 (setq hyper-apropos-prev-wconfig (current-window-configuration))) 465 (setq hyper-apropos-prev-wconfig (current-window-configuration)))
529 (completing-read 522 (completing-read
530 (concat prompt 523 (concat prompt
531 (if v 524 (if v
532 (format " (default %s): " v) 525 (format " (default %s): " v)
533 ": ")) 526 ": "))
534 obarray predicate t nil 'variable-history 527 obarray predicate t nil 'variable-history)))
535 (and v (symbol-name v))))) 528 (if (string= val "")
536 (intern-soft val))) 529 (progn (push (symbol-name v) variable-history) v)
537 530 (intern-soft val))))
538 ;;;###autoload 531 ;;;###autoload
539 (define-obsolete-function-alias 532 (define-obsolete-function-alias
540 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol) 533 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol)
541 534
542 (defun hyper-apropos-read-function-symbol (prompt) 535 (defun hyper-apropos-read-function-symbol (prompt)
548 (setq val (let ((enable-recursive-minibuffers t)) 541 (setq val (let ((enable-recursive-minibuffers t))
549 (completing-read (if fn 542 (completing-read (if fn
550 (format "%s (default %s): " prompt fn) 543 (format "%s (default %s): " prompt fn)
551 (format "%s: " prompt)) 544 (format "%s: " prompt))
552 obarray 'fboundp t nil 545 obarray 'fboundp t nil
553 'function-history 546 'function-history)))
554 (and fn (symbol-name fn))))) 547 (if (equal val "")
555 (intern-soft val))) 548 (progn (push (symbol-name fn) function-history) fn)
549 (intern-soft val))))
556 550
557 (defun hyper-apropos-last-help (arg) 551 (defun hyper-apropos-last-help (arg)
558 "Go back to the last symbol documented in the *Hyper Help* buffer." 552 "Go back to the last symbol documented in the *Hyper Help* buffer."
559 (interactive "P") 553 (interactive "P")
560 (let ((win (get-buffer-window hyper-apropos-help-buf))) 554 (let ((win (get-buffer-window hyper-apropos-help-buf)))
1083 (beginning-of-line) 1077 (beginning-of-line)
1084 (if (looking-at hyper-apropos-junk-regexp) 1078 (if (looking-at hyper-apropos-junk-regexp)
1085 nil 1079 nil
1086 (forward-char 3) 1080 (forward-char 3)
1087 (read (point-marker)))) 1081 (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)))
1094 (t 1082 (t
1095 (let* ((st (progn 1083 (let* ((st (progn
1096 (skip-syntax-backward "w_") 1084 (skip-syntax-backward "w_")
1097 ;; !@(*$^%%# stupid backquote implementation!!! 1085 ;; !@(*$^%%# stupid backquote implementation!!!
1098 (skip-chars-forward "`") 1086 (skip-chars-forward "`")
1131 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer) 1119 (defun hyper-apropos-set-variable (var val &optional this-ref-buffer)
1132 "Interactively set the variable on the current line." 1120 "Interactively set the variable on the current line."
1133 (interactive 1121 (interactive
1134 (let ((var (hyper-apropos-this-symbol))) 1122 (let ((var (hyper-apropos-this-symbol)))
1135 (or (and var (boundp var)) 1123 (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))
1136 (setq var nil)) 1129 (setq var nil))
1137 (list var (hyper-apropos-read-variable-value var)))) 1130 (list var (hyper-apropos-read-variable-value var))))
1138 (and var 1131 (and var
1139 (boundp var) 1132 (boundp var)
1140 (progn 1133 (progn
1180 (error nil))))))) 1173 (error nil)))))))
1181 1174
1182 (defun hyper-apropos-customize-variable () 1175 (defun hyper-apropos-customize-variable ()
1183 (interactive) 1176 (interactive)
1184 (let ((var (hyper-apropos-this-symbol))) 1177 (let ((var (hyper-apropos-this-symbol)))
1185 (and 1178 (customize-variable var)))
1186 (or (and var (boundp var))
1187 (setq var nil))
1188 (customize-variable var))))
1189 1179
1190 ;; ---------------------------------------------------------------------- ;; 1180 ;; ---------------------------------------------------------------------- ;;
1191 1181
1192 (defun hyper-apropos-find-tag (&optional tag-name) 1182 (defun hyper-apropos-find-tag (&optional tag-name)
1193 "Find the tag for the symbol on the current line in other window. In 1183 "Find the tag for the symbol on the current line in other window. In
1205 "Find the function for the symbol on the current line in other 1195 "Find the function for the symbol on the current line in other
1206 window. (See also `find-function'.)" 1196 window. (See also `find-function'.)"
1207 (interactive 1197 (interactive
1208 (let ((fn (hyper-apropos-this-symbol))) 1198 (let ((fn (hyper-apropos-this-symbol)))
1209 (or (fboundp fn) 1199 (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))
1210 (setq fn nil)) 1205 (setq fn nil))
1211 (list fn))) 1206 (list fn)))
1212 (if fn 1207 (if fn
1213 (find-function-other-window fn))) 1208 (find-function-other-window fn)))
1214 1209
1260 1255
1261 ;;;###autoload 1256 ;;;###autoload
1262 (defun hyper-apropos-popup-menu (event) 1257 (defun hyper-apropos-popup-menu (event)
1263 (interactive "e") 1258 (interactive "e")
1264 (mouse-set-point event) 1259 (mouse-set-point event)
1265 (let* ((sym (hyper-apropos-this-symbol)) 1260 (let* ((sym (or (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)))))
1266 (notjunk (not (null sym))) 1265 (notjunk (not (null sym)))
1267 (command-p (if (commandp sym) t)) 1266 (command-p (if (commandp sym) t))
1268 (variable-p (and sym (boundp sym))) 1267 (variable-p (and sym (boundp sym)))
1269 (customizable-p (and variable-p 1268 (customizable-p (and variable-p
1270 (get sym 'custom-type) 1269 (get sym 'custom-type)