Add preliminary describe-package functionality, and some cleanup.

* help-mode.el (help-package-def): New button type.

* menu-bar.el: Move package-list-packages binding here from
package.el.

* emacs-lisp/package.el: Move package-list-packages binding to
menu-bar.el.
(describe-package, describe-package-1, package--dir): New funs.
(package-activate-1): Use package--dir.

* emacs-lisp/package-x.el (gnus-article-buffer): Require package.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f0e152d3ffe80b31b832ae0ecf89d63bc537d7dd..f4d0d1ac2b1627766d4a93128a010de8f85f75a6 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2010-06-19  Chong Yidong  <cyd@stupidchicken.com>
+
+       * emacs-lisp/package.el: Move package-list-packages binding to
+       menu-bar.el.
+       (describe-package, describe-package-1, package--dir): New funs.
+       (package-activate-1): Use package--dir.
+
+       * emacs-lisp/package-x.el (gnus-article-buffer): Require package.
+
+       * help-mode.el (help-package-def): New button type.
+
+       * menu-bar.el: Move package-list-packages binding here from
+       package.el.
+
 2010-06-19  Gustav Hållberg  <gustav@gmail.com>  (tiny change)
 
        * descr-text.el (describe-char): Avoid trailing whitespace.  (Bug#6423)

diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index c2d85aa574a067b7784a9bd4dd11c8cc740fd520..21bd7960d890278220dbc35511d457c600666678 100644 (file)
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -31,6 +31,9 @@
 
 ;;; Code:
 
+(require 'package)
+(defvar gnus-article-buffer)
+
 ;; Note that this only works if you have the password, which you
 ;; probably don't :-).
 (defvar package-archive-upload-base nil

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 54a2ba610cacb55b937da4d6ab63b62ad113b7aa..2a93535718c45d123369478654e6adbff7628965 100644 (file)
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -211,7 +211,6 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
   :version "24.1")
 
 (defvar Info-directory-list)
-(defvar gnus-article-buffer)
 (declare-function info-initialize "info" ())
 (declare-function url-http-parse-response "url-http" ())
 (declare-function lm-header "lisp-mnt" (header))
@@ -423,33 +422,35 @@ updates `package-alist' and `package-obsolete-alist'."
   "Extract the kind of download from an archive package description vector."
   (aref desc 3))
 
-(defun package-activate-1 (package pkg-vec)
-  (let* ((pkg-name (symbol-name package))
-        (pkg-ver-str (package-version-join (package-desc-vers pkg-vec)))
+(defun package--dir (name version-string)
+  (let* ((subdir (concat name "-" version-string))
         (dir-list (cons package-user-dir package-directory-list))
-        (pkg-dir))
+        pkg-dir)
     (while dir-list
-      (let ((subdir (expand-file-name (concat pkg-name "-" pkg-ver-str)
-                                     (car dir-list))))
-       (if (file-directory-p subdir)
-           (progn
-             (setq pkg-dir subdir)
-             (setq dir-list nil))
+      (let ((subdir-full (expand-file-name subdir (car dir-list))))
+       (if (file-directory-p subdir-full)
+           (setq pkg-dir  subdir-full
+                 dir-list nil)
          (setq dir-list (cdr dir-list)))))
+    pkg-dir))
+
+(defun package-activate-1 (package pkg-vec)
+  (let* ((name (symbol-name package))
+        (version-str (package-version-join (package-desc-vers pkg-vec)))
+        (pkg-dir (package--dir name version-str)))
     (unless pkg-dir
       (error "Internal error: could not find directory for %s-%s"
-            pkg-name pkg-ver-str))
+            name version-str))
+    ;; Add info node.
     (if (file-exists-p (expand-file-name "dir" pkg-dir))
        (progn
          ;; FIXME: not the friendliest, but simple.
          (require 'info)
          (info-initialize)
          (setq Info-directory-list (cons pkg-dir Info-directory-list))))
+    ;; Add to load path, add autoloads, and activate the package.
     (setq load-path (cons pkg-dir load-path))
-    ;; Load the autoloads and activate the package.
-    (load (expand-file-name (concat (symbol-name package) "-autoloads")
-                           pkg-dir)
-         nil t)
+    (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
     (setq package-activated-list (cons package package-activated-list))
     ;; Don't return nil.
     t))
@@ -474,8 +475,7 @@ Return nil if the package could not be activated."
     (let* ((pkg-desc (assq package package-alist))
           (this-version (package-desc-vers (cdr pkg-desc)))
           (req-list (package-desc-reqs (cdr pkg-desc)))
-          ;; If the package was never activated, we want to do it
-          ;; now.
+          ;; If the package was never activated, do it now.
           (keep-going (or (not (memq package package-activated-list))
                           (package-version-compare this-version version '>))))
       (while (and req-list keep-going)
@@ -1037,7 +1037,70 @@ The variable `package-load-list' controls which packages to load."
        package-alist))
 
 \f
+;;;; Package description buffer.
 
+;;;###autoload
+(defun describe-package (package)
+  "Display the full documentation of PACKAGE (a symbol)."
+  (interactive
+   (let* ((packages (append (mapcar 'car package-alist)
+                           (mapcar 'car package-archive-contents)))
+         (guess (function-called-at-point))
+         val)
+     (unless (memq guess packages)
+       (setq guess nil))
+     (setq packages (mapcar 'symbol-name packages))
+     (setq val
+          (completing-read (if guess
+                               (format "Describe package (default %s): "
+                                       guess)
+                             "Describe package: ")
+                           packages nil t nil nil guess))
+     (list (if (equal val "")
+              guess
+            (intern val)))))
+  (if (or (null package) (null (symbolp package)))
+      (message "You did not specify a package")
+    (help-setup-xref (list #'describe-package package)
+                    (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+       (describe-package-1 package)))))
+
+(defun describe-package-1 (package)
+  (let ((desc (cdr (assq package package-alist)))
+       version)
+    (prin1 package)
+    (princ " is ")
+    (cond
+     (desc
+      ;; This package is loaded (i.e. in `package-alist').
+      (let (pkg-dir)
+       (setq version (package-version-join (package-desc-vers desc)))
+       (if (assq package package--builtins)
+           (princ "a built-in package.\n\n")
+         (setq pkg-dir (package--dir (symbol-name package) version))
+         (if pkg-dir
+             (progn
+               (insert "a package installed in `")
+               (help-insert-xref-button (file-name-as-directory pkg-dir)
+                                        'help-package-def pkg-dir)
+               (insert "'.\n\n"))
+           ;; This normally does not happen.
+           (insert "a deleted package.\n\n")
+           (setq version nil)))))
+     (t
+      ;; An uninstalled package.
+      (setq desc (cdr (assq package package-archive-contents)))
+      (setq version (package-version-join (package-desc-vers desc)))
+      (insert "a package that is not installed.\n\n")))
+    (if version
+       (insert "      Version: " version "\n"))
+    (insert "  Description: " (package-desc-doc desc) "\n")))
+;; To do: add buttons for installing, uninstalling, etc.
+
+
+\f
 ;;;; Package menu mode.
 
 (defvar package-menu-mode-map
@@ -1443,11 +1506,6 @@ The list is displayed in a buffer named `*Packages*'."
   (interactive)
   (package--list-packages))
 
-;; Make it appear on the menu.
-(define-key-after menu-bar-options-menu [package]
-  '(menu-item "Manage Packages" package-list-packages
-             :help "Install or uninstall additional Emacs packages"))
-
 (provide 'package)
 
 ;;; package.el ends here

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index c478bf6d16cea890ff0cfdaf6bfbf814828ac00f..b04a289b4ae548fcc0bfb84b0324e96abcdbf749 100644 (file)
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -244,6 +244,11 @@ The format is (FUNCTION ARGS...).")
                       (message "Unable to find location in file"))))
   'help-echo (purecopy "mouse-2, RET: find face's definition"))
 
+(define-button-type 'help-package-def
+  :supertype 'help-xref
+  'help-function (lambda (file) (dired file))
+  'help-echo (purecopy "mouse-2, RET: visit package directory"))
+
 \f
 ;;;###autoload
 (defun help-mode ()

diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 2d5b6d51aa62504f3763b232c45bafc5c8981068..903bea36044a77f36881a2ec61a01370ab288ad5 100644 (file)
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -703,6 +703,10 @@ by \"Save Options\" in Custom buffers.")
     (when need-save
       (custom-save-all))))
 
+(define-key menu-bar-options-menu [package]
+  '(menu-item "Manage Emacs Packages" package-list-packages
+             :help "Install or uninstall additional Emacs packages"))
+
 (define-key menu-bar-options-menu [save]
   `(menu-item ,(purecopy "Save Options") menu-bar-options-save
              :help ,(purecopy "Save options set from the menu above")))