changeset 95645:454e3c065a98

(apropos-library): New command and new button. (apropos-library-button): New function.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 08 Jun 2008 04:32:43 +0000
parents 0e6597218883
children 816ec0114c3c
files etc/NEWS lisp/ChangeLog lisp/apropos.el
diffstat 3 files changed, 71 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Sun Jun 08 03:48:22 2008 +0000
+++ b/etc/NEWS	Sun Jun 08 04:32:43 2008 +0000
@@ -63,6 +63,8 @@
 
 * 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.
--- a/lisp/ChangeLog	Sun Jun 08 03:48:22 2008 +0000
+++ b/lisp/ChangeLog	Sun Jun 08 04:32:43 2008 +0000
@@ -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.
--- a/lisp/apropos.el	Sun Jun 08 03:48:22 2008 +0000
+++ b/lisp/apropos.el	Sun Jun 08 04:32:43 2008 +0000
@@ -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))