[Emacs-diffs] Changes to emacs/lisp/apropos.el,v

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        08/06/08 04:32:43

Index: lisp/apropos.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/apropos.el,v
retrieving revision 1.128
retrieving revision 1.129
diff -u -b -r1.128 -r1.129
--- lisp/apropos.el     8 Jun 2008 03:48:22 -0000       1.128
+++ lisp/apropos.el     8 Jun 2008 04:32:43 -0000       1.129
@@ -250,6 +250,12 @@
   'action (lambda (button)
            (apropos-describe-plist (button-get button 'apropos-symbol))))
 
+(define-button-type 'apropos-library
+  'help-echo "mouse-2, RET: Display more help on this library"
+  'follow-link t
+  'action (lambda (button)
+           (apropos-library (button-get button 'apropos-symbol))))
+
 (defun apropos-next-label-button (pos)
   "Return the next apropos label button after POS, or nil if there's none.
 Will also return nil if more than one `apropos-symbol' button is encountered
@@ -531,6 +537,66 @@
                                (symbol-plist symbol)))))
    (or do-all apropos-do-all)))
 
+(defun apropos-library-button (sym)
+  (if (null sym)
+      "<nothing>"
+    (let ((name (copy-sequence (symbol-name sym))))
+      (make-text-button name nil
+                        'type 'apropos-library
+                        'face apropos-symbol-face
+                        'apropos-symbol name)
+      name)))
+
+;;;###autoload
+(defun apropos-library (file)
+  "List the variables and functions defined by library FILE.
+FILE should be one of the libraries currently loaded and should
+thus be found in `load-history'."
+  (interactive
+   (let ((libs
+          (nconc (delq nil
+                       (mapcar
+                        (lambda (l)
+                          (setq l (file-name-nondirectory l))
+                          (while
+                              (not (equal (setq l (file-name-sans-extension l))
+                                          l)))
+                          l)
+                        (mapcar 'car load-history)))
+                 (mapcar 'car load-history))))
+     (list (completing-read "Describe library: " libs nil t))))
+  (let ((symbols nil)
+       ;; (autoloads nil)
+       (provides nil)
+       (requires nil)
+        (lh-entry (assoc file load-history)))
+    (unless lh-entry
+      ;; `file' may be the "shortname".
+      (let ((lh load-history)
+            (re (concat "\\(?:\\`\\|[\\/]\\)" (regexp-quote file)
+                        "\\(\\.\\|\\'\\)")))
+        (while (and lh (null lh-entry))
+          (if (string-match re (caar lh))
+              (setq lh-entry (car lh))
+            (setq lh (cdr lh)))))
+      (unless lh-entry (error "Unknown library `%s'" file)))
+    (dolist (x (cdr lh-entry))
+      (case (car-safe x)
+       ;; (autoload (push (cdr x) autoloads))
+       (require (push (cdr x) requires))
+       (provide (push (cdr x) provides))
+       (t (push (or (cdr-safe x) x) symbols))))
+    (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
+      (apropos-symbols-internal
+       symbols apropos-do-all
+       (concat
+        (format "Library `%s' provides: %s\nand requires: %s"
+                file
+                (mapconcat 'apropos-library-button
+                           (or provides '(nil)) " and ")
+                (mapconcat 'apropos-library-button
+                           (or requires '(nil)) " and ")))))))
+
 (defun apropos-symbols-internal (symbols keys &optional text)
   ;; Filter out entries that are marked as apropos-inhibit.
   (let ((all nil))