emacs: lisp/apropos.el comparison

comparison lisp/apropos.el @ 54582:91f663907945

(apropos-mode): Don't autoload. (apropos-symbols-internal): New fun. Extracted from `apropos'. (apropos): Use it. (apropos-print): Add optional `text' argument. (apropos-describe-plist): Use help-buffer and hexlp-setup-xref. Don't assume point-min == 1.

author	Stefan Monnier <monnier@iro.umontreal.ca>
date	Fri, 26 Mar 2004 15:27:56 +0000
parents	695cf19ef79e
children	5d7aec33a1ba

comparison

equal deleted inserted replaced

-:0a5e192bf05d
+:91f663907945
 ;;; apropos.el --- apropos commands for users and programmers
-;; Copyright (C) 1989, 1994, 1995, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1989,94,1995,2001,02,03,2004  Free Software Foundation, Inc.
 ;; Author: Joe Wells <jbw@bigbird.bu.edu>
 ;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org>
 ;; Keywords: help
 ;;   from buffer in active window.
 ;;; Code:
 (require 'button)
+(eval-when-compile (require 'cl))
 (defgroup apropos nil
 "Apropos commands for users and programmers"
 :group 'help
 :prefix "apropos")
 (defun apropos-true-hit-doc (doc)
 "Return t if DOC is really matched by the current keywords."
 (apropos-true-hit doc apropos-all-words))
-;;;###autoload
 (define-derived-mode apropos-mode fundamental-mode "Apropos"
 "Major mode for following hyperlinks in output of apropos commands.
 \\{apropos-mode-map}")
 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also
 show unbound symbols and key bindings, which is a little more
 time-consuming.  Returns list of symbols and documentation found."
 (interactive "sApropos symbol (regexp or words): \nP")
 (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp))
-(setq apropos-accumulator
+(apropos-symbols-internal
-	(apropos-internal apropos-regexp
+(apropos-internal apropos-regexp
 			  (and (not do-all)
 			       (not apropos-do-all)
 			       (lambda (symbol)
 				 (or (fboundp symbol)
 				     (boundp symbol)
 				     (facep symbol)
-				     (symbol-plist symbol))))))
+				     (symbol-plist symbol)))))
-(let ((tem apropos-accumulator))
+(or do-all apropos-do-all)))
-(while tem
-(if (get (car tem) 'apropos-inhibit)
+(defun apropos-symbols-internal (symbols keys &optional text)
-	  (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
+;; Filter out entries that are marked as apropos-inhibit.
-(setq tem (cdr tem))))
+(let ((all nil))
-(let ((p apropos-accumulator)
+(dolist (symbol symbols)
-	symbol doc properties)
+(unless (get symbol 'apropos-inhibit)
-(while p
+	(push symbol all)))
-(setcar p (list
+(setq symbols all))
-		 (setq symbol (car p))
+(let ((apropos-accumulator
-		 (apropos-score-symbol symbol)
+	 (mapcar
-		 (when (fboundp symbol)
+	  (lambda (symbol)
-		   (if (setq doc (condition-case nil
+	    (let (doc properties)
-				     (documentation symbol t)
+	      (list
-				   (void-function
+	       symbol
-				    "(alias for undefined function)")
+	       (apropos-score-symbol symbol)
-				   (error
+	       (when (fboundp symbol)
-				    "(error retrieving function documentation)")))
+		 (if (setq doc (condition-case nil
-		       (substring doc 0 (string-match "\n" doc))
+				   (documentation symbol t)
-		     "(not documented)"))
+				 (void-function
-		 (when (boundp symbol)
+				  "(alias for undefined function)")
-		   (apropos-documentation-property
+				 (error
+				  "(can't retrieve function documentation)")))
+		     (substring doc 0 (string-match "\n" doc))
+		   "(not documented)"))
+	       (when (boundp symbol)
+		 (apropos-documentation-property
 		    symbol 'variable-documentation t))
 		 (when (setq properties (symbol-plist symbol))
 		   (setq doc (list (car properties)))
 		   (while (setq properties (cdr (cdr properties)))
 		     (setq doc (cons (car properties) doc)))
 		   (mapconcat #'symbol-name (nreverse doc) " "))
 		 (when (get symbol 'widget-type)
 		   (apropos-documentation-property
 		    symbol 'widget-documentation t))
-		 (when (facep symbol)
+	       (when (facep symbol)
+		 (apropos-documentation-property
+		  symbol 'face-documentation t))
+	       (when (get symbol 'custom-group)
 		   (apropos-documentation-property
-		    symbol 'face-documentation t))
+		    symbol 'group-documentation t)))))
-		 (when (get symbol 'custom-group)
+	  symbols)))
-		   (apropos-documentation-property
+(apropos-print keys nil text)))
-		    symbol 'group-documentation t))))
-(setq p (cdr p))))
-(apropos-print
-(or do-all apropos-do-all)
-nil))
 ;;;###autoload
 (defun apropos-value (apropos-regexp &optional do-all)
 "Show all symbols whose value's printed image matches APROPOS-REGEXP.
 (if (integerp function)
 nil
 function))
-(defun apropos-print (do-keys spacing)
+(defun apropos-print (do-keys spacing &optional text)
 "Output result of apropos searching into buffer `*Apropos*'.
 The value of `apropos-accumulator' is the list of items to output.
 Each element should have the format
 (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]).
 The return value is the list that was in `apropos-accumulator', sorted
 alphabetically by symbol name; but this function also sets
 `apropos-accumulator' to nil before returning.
-If SPACING is non-nil, it should be a string;
+If SPACING is non-nil, it should be a string; separate items with that string.
-separate items with that string."
+If non-nil TEXT is a string that will be printed as a heading."
 (if (null apropos-accumulator)
 (message "No apropos matches for `%s'" apropos-orig-regexp)
 (setq apropos-accumulator
 	  (sort apropos-accumulator
 		(lambda (a b)
 	     "get more information.\n"))
 	(insert "In this buffer, go to the name of the command, or function,"
 		" or variable,\n"
 		(substitute-command-keys
 		 "and type \\[apropos-follow] to get full documentation.\n\n"))
+	(if text (insert text "\n\n"))
 	(while (consp p)
 	  (when (and spacing (not (bobp)))
 	    (princ spacing))
 	  (setq apropos-item (car p)
 		symbol (car apropos-item)
 (error "There is nothing to follow here"))))
 (defun apropos-describe-plist (symbol)
 "Display a pretty listing of SYMBOL's plist."
-(with-output-to-temp-buffer "*Help*"
+(help-setup-xref (list 'apropos-describe-plist symbol) (interactive-p))
+(with-output-to-temp-buffer (help-buffer)
 (set-buffer standard-output)
 (princ "Symbol ")
 (prin1 symbol)
 (princ "'s plist is\n (")
 (if apropos-symbol-face
-	(put-text-property 8 (- (point) 14) 'face apropos-symbol-face))
+	(put-text-property (+ (point-min) 7) (- (point) 14)
+			   'face apropos-symbol-face))
 (insert (apropos-format-plist symbol "\n  "))
 (princ ")")
 (print-help-return-message)))

Mercurial > emacs

comparison lisp/apropos.el @ 54582:91f663907945