diff options
| -rw-r--r-- | lisp/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package-x.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 104 | ||||
| -rw-r--r-- | lisp/help-mode.el | 5 | ||||
| -rw-r--r-- | lisp/menu-bar.el | 4 |
5 files changed, 107 insertions, 23 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f0e152d3ffe..f4d0d1ac2b1 100644 --- 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 c2d85aa574a..21bd7960d89 100644 --- 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 54a2ba610ca..2a93535718c 100644 --- 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)) +;;;; 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. + + + ;;;; 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 c478bf6d16c..b04a289b4ae 100644 --- 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")) + ;;;###autoload (defun help-mode () diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 2d5b6d51aa6..903bea36044 100644 --- 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"))) |