/[emacs]/emacs/lisp/apropos.el
ViewVC logotype

Diff of /emacs/lisp/apropos.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.87 by kfstorm, Thu May 23 20:21:30 2002 UTC revision 1.87.2.1 by miles, Fri Apr 4 06:20:00 2003 UTC
# Line 206  term, and the rest of the words are alte Line 206  term, and the rest of the words are alte
206    'apropos-label "Group"    'apropos-label "Group"
207    'help-echo "mouse-2, RET: Display more help on this group"    'help-echo "mouse-2, RET: Display more help on this group"
208    'action (lambda (button)    'action (lambda (button)
209              (customize-variable-other-window              (customize-group-other-window
210               (button-get button 'apropos-symbol))))               (button-get button 'apropos-symbol))))
211    
212  (define-button-type 'apropos-widget  (define-button-type 'apropos-widget
# Line 247  before finding a label." Line 247  before finding a label."
247    (concat "\\("    (concat "\\("
248            (mapconcat 'identity words "\\|")            (mapconcat 'identity words "\\|")
249            "\\)" wild            "\\)" wild
250            (if (cdr words)            (if (cdr words)
251                (concat "\\("                (concat "\\("
252                        (mapconcat 'identity words "\\|")                        (mapconcat 'identity words "\\|")
253                        "\\)")                        "\\)")
# Line 314  Value is a list of offsets of the words Line 314  Value is a list of offsets of the words
314          (dolist (s (apropos-calc-scores doc apropos-all-words) score)          (dolist (s (apropos-calc-scores doc apropos-all-words) score)
315            (setq score (+ score 50 (/ (* (- l s) 50) l)))))            (setq score (+ score 50 (/ (* (- l s) 50) l)))))
316        0))        0))
317              
318  (defun apropos-score-symbol (symbol &optional weight)  (defun apropos-score-symbol (symbol &optional weight)
319    "Return apropos score for SYMBOL."    "Return apropos score for SYMBOL."
320    (setq symbol (symbol-name symbol))    (setq symbol (symbol-name symbol))
# Line 372  normal variables." Line 372  normal variables."
372    
373  ;; For auld lang syne:  ;; For auld lang syne:
374  ;;;###autoload  ;;;###autoload
375  (fset 'command-apropos 'apropos-command)  (defalias 'command-apropos 'apropos-command)
376  ;;;###autoload  ;;;###autoload
377  (defun apropos-command (apropos-regexp &optional do-all var-predicate)  (defun apropos-command (apropos-regexp &optional do-all var-predicate)
378    "Show commands (interactively callable functions) that match APROPOS-REGEXP.    "Show commands (interactively callable functions) that match APROPOS-REGEXP.
# Line 413  satisfy the predicate VAR-PREDICATE." Line 413  satisfy the predicate VAR-PREDICATE."
413                       (if (functionp symbol)                       (if (functionp symbol)
414                           (if (setq doc (documentation symbol t))                           (if (setq doc (documentation symbol t))
415                               (progn                               (progn
416                                 (setq score (+ score (apropos-score-doc doc)))                                 (setq score (+ score (apropos-score-doc doc)))
417                                 (substring doc 0 (string-match "\n" doc)))                                 (substring doc 0 (string-match "\n" doc)))
418                             "(not documented)")))                             "(not documented)")))
419                     (and var-predicate                     (and var-predicate
# Line 432  satisfy the predicate VAR-PREDICATE." Line 432  satisfy the predicate VAR-PREDICATE."
432    
433    
434  ;;;###autoload  ;;;###autoload
435    (defun apropos-documentation-property (symbol property raw)
436      "Like (documentation-property SYMBOL PROPERTY RAW) but handle errors."
437      (condition-case ()
438          (let ((doc (documentation-property symbol property raw)))
439            (if doc (substring doc 0 (string-match "\n" doc))
440              "(not documented)"))
441        (error "(error retrieving documentation)")))
442    
443    
444    ;;;###autoload
445  (defun apropos (apropos-regexp &optional do-all)  (defun apropos (apropos-regexp &optional do-all)
446    "Show all bound symbols whose names match APROPOS-REGEXP.    "Show all bound symbols whose names match APROPOS-REGEXP.
447  With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also  With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also
# Line 463  time-consuming.  Returns list of symbols Line 473  time-consuming.  Returns list of symbols
473                     (if (setq doc (condition-case nil                     (if (setq doc (condition-case nil
474                                       (documentation symbol t)                                       (documentation symbol t)
475                                     (void-function                                     (void-function
476                                      "(alias for undefined function)")))                                      "(alias for undefined function)")
477                                       (error
478                                        "(error retrieving function documentation)")))
479                         (substring doc 0 (string-match "\n" doc))                         (substring doc 0 (string-match "\n" doc))
480                       "(not documented)"))                       "(not documented)"))
481                   (when (boundp symbol)                   (when (boundp symbol)
482                     (if (setq doc (documentation-property                     (apropos-documentation-property
483                                    symbol 'variable-documentation t))                      symbol 'variable-documentation t))
                        (substring doc 0 (string-match "\n" doc))  
                      "(not documented)"))  
484                   (when (setq properties (symbol-plist symbol))                   (when (setq properties (symbol-plist symbol))
485                     (setq doc (list (car properties)))                     (setq doc (list (car properties)))
486                     (while (setq properties (cdr (cdr properties)))                     (while (setq properties (cdr (cdr properties)))
487                       (setq doc (cons (car properties) doc)))                       (setq doc (cons (car properties) doc)))
488                     (mapconcat #'symbol-name (nreverse doc) " "))                     (mapconcat #'symbol-name (nreverse doc) " "))
489                   (when (get symbol 'widget-type)                   (when (get symbol 'widget-type)
490                     (if (setq doc (documentation-property                     (apropos-documentation-property
491                                    symbol 'widget-documentation t))                      symbol 'widget-documentation t))
                        (substring doc 0  
                                   (string-match "\n" doc))  
                      "(not documented)"))  
492                   (when (facep symbol)                   (when (facep symbol)
493                     (if (setq doc (documentation-property                     (apropos-documentation-property
494                                    symbol 'face-documentation t))                      symbol 'face-documentation t))
                        (substring doc 0  
                                   (string-match "\n" doc))  
                      "(not documented)"))  
495                   (when (get symbol 'custom-group)                   (when (get symbol 'custom-group)
496                     (if (setq doc (documentation-property                     (apropos-documentation-property
497                                    symbol 'group-documentation t))                      symbol 'group-documentation t))))
                        (substring doc 0  
                                   (string-match "\n" doc))  
                      "(not documented)"))))  
498        (setq p (cdr p))))        (setq p (cdr p))))
499    (apropos-print    (apropos-print
500     (or do-all apropos-do-all)     (or do-all apropos-do-all)
# Line 530  Returns list of symbols and values found Line 531  Returns list of symbols and values found
531          (if (apropos-false-hit-str p)          (if (apropos-false-hit-str p)
532              (setq p nil))              (setq p nil))
533          (if (or f v p)          (if (or f v p)
534              (setq apropos-accumulator (cons (list symbol              (setq apropos-accumulator (cons (list symbol
535                                                    (+ (apropos-score-str f)                                                    (+ (apropos-score-str f)
536                                                       (apropos-score-str v)                                                       (apropos-score-str v)
537                                                       (apropos-score-str p))                                                       (apropos-score-str p))
# Line 579  Returns list of symbols and documentatio Line 580  Returns list of symbols and documentatio
580                                   (setcar (nthcdr 2 apropos-item) v)                                   (setcar (nthcdr 2 apropos-item) v)
581                                   (setcar apropos-item (+ (car apropos-item) sv)))))                                   (setcar apropos-item (+ (car apropos-item) sv)))))
582                         (setq apropos-accumulator                         (setq apropos-accumulator
583                               (cons (list symbol                               (cons (list symbol
584                                           (+ (apropos-score-symbol symbol 2) sf sv)                                           (+ (apropos-score-symbol symbol 2) sf sv)
585                                           f v)                                           f v)
586                                     apropos-accumulator)))))))                                     apropos-accumulator)))))))
# Line 664  Returns list of symbols and documentatio Line 665  Returns list of symbols and documentatio
665                (or (and (setq apropos-item (assq symbol apropos-accumulator))                (or (and (setq apropos-item (assq symbol apropos-accumulator))
666                         (setcar (cdr apropos-item)                         (setcar (cdr apropos-item)
667                                 (+ (cadr apropos-item) (apropos-score-doc doc))))                                 (+ (cadr apropos-item) (apropos-score-doc doc))))
668                    (setq apropos-item (list symbol                    (setq apropos-item (list symbol
669                                             (+ (apropos-score-symbol symbol 2)                                             (+ (apropos-score-symbol symbol 2)
670                                                (apropos-score-doc doc))                                                (apropos-score-doc doc))
671                                             nil nil)                                             nil nil)
# Line 754  Will return nil instead." Line 755  Will return nil instead."
755  (defun apropos-print (do-keys spacing)  (defun apropos-print (do-keys spacing)
756    "Output result of apropos searching into buffer `*Apropos*'.    "Output result of apropos searching into buffer `*Apropos*'.
757  The value of `apropos-accumulator' is the list of items to output.  The value of `apropos-accumulator' is the list of items to output.
758  Each element should have the format  Each element should have the format
759   (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]).   (SYMBOL SCORE FN-DOC VAR-DOC [PLIST-DOC WIDGET-DOC FACE-DOC GROUP-DOC]).
760  The return value is the list that was in `apropos-accumulator', sorted  The return value is the list that was in `apropos-accumulator', sorted
761  alphabetically by symbol name; but this function also sets  alphabetically by symbol name; but this function also sets

Legend:
Removed from v.1.87  
changed lines
  Added in v.1.87.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26