(apropos-library): New command and new button.

(apropos-library-button): New function.

diff --git a/etc/NEWS b/etc/NEWS
index 4be44175e7338267d3dff74bb9fc9b82cff66618..73c6dacecf32639c9005d75866b02c9aba3d1b4d 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -63,6 +63,8 @@ default toolkit, but you can use --with-x-toolkit=gtk if necessary.
 \f
 * Changes in Emacs 23.1
 
+** `apropos-library' describes the elements defined in a given library.
+
 ** scroll-preserve-screen-position also preserves the column position.
 ** Completion.
 *** `completion-styles' can be customized to choose your favorite completion.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 91c276b2ba73445dda07cac314bb0f4e79bc09ba..f7bb9fc3205206854739eb8f6ab4d5ec412eec53 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2008-06-08  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * apropos.el (apropos-library): New command and new button.
+       (apropos-library-button): New function.
+
        * apropos.el: Remove spurious * in docstrings.
        (apropos-label-face): Use variable pitch.
        (apropos-print): Use dolist and with-current-buffer.

diff --git a/lisp/apropos.el b/lisp/apropos.el
index a073d29352475ed2a1f5801f6d6c46eb718ca5f4..d453cb89de8c02694bf58d3fff84132373ea3b49 100644 (file)
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -250,6 +250,12 @@ term, and the rest of the words are alternative terms.")
   '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 @@ Returns list of symbols and documentation found."
                                (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))