Mercurial > emacs
changeset 109226:a4002b21a37b
Merge from mainline.
| author | Katsumi Yamaoka <katsumi@flagship2> |
|---|---|
| date | Sun, 20 Jun 2010 11:23:04 +0000 |
| parents | cf1662d15309 (current diff) 858e3e43cfd5 (diff) |
| children | 2b07fb05e3ed |
| files | |
| diffstat | 5 files changed, 178 insertions(+), 27 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Jun 19 12:15:25 2010 +0000 +++ b/lisp/ChangeLog Sun Jun 20 11:23:04 2010 +0000 @@ -1,3 +1,27 @@ +2010-06-20 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-print-package): Add link to + package description via describe-package. + (describe-package-1): List package requirements. Add button to + perform installation. + (package-menu-describe-package): New command. + + * help-mode.el (help-package): New button type. + +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)
--- a/lisp/emacs-lisp/package-x.el Sat Jun 19 12:15:25 2010 +0000 +++ b/lisp/emacs-lisp/package-x.el Sun Jun 20 11:23:04 2010 +0000 @@ -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
--- a/lisp/emacs-lisp/package.el Sat Jun 19 12:15:25 2010 +0000 +++ b/lisp/emacs-lisp/package.el Sun Jun 20 11:23:04 2010 +0000 @@ -211,7 +211,6 @@ :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 @@ "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 @@ (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,13 +1037,114 @@ 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))) + reqs version installable) + (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)) + version (package-version-join (package-desc-vers desc)) + installable t) + (insert "an installable package.\n\n"))) + (if version + (insert " Version: " version "\n")) + (setq reqs (package-desc-reqs desc)) + (when reqs + (insert " Requires: ") + (let ((first t) + name vers text) + (dolist (req reqs) + (setq name (car req) + vers (cadr req) + text (format "%s-%s" (symbol-name name) + (package-version-join vers))) + (cond (first (setq first nil)) + ((>= (+ 2 (current-column) (length text)) + (window-width)) + (insert ",\n ")) + (t (insert ", "))) + (help-insert-xref-button text 'help-package name)) + (insert "\n"))) + (insert " Description: " (package-desc-doc desc) "\n") + ;; Todo: button for uninstalling a package. + (when installable + (let ((button-text (if (display-graphic-p) + "Install" + "[Install]")) + (button-face (if (display-graphic-p) + '(:box (:line-width 2 :color "dark grey") + :background "light grey" + :foreground "black") + 'link))) + (insert "\n") + (insert-text-button button-text + 'face button-face + 'follow-link t + 'package-symbol package + 'action (lambda (button) + (package-install + (button-get button 'package-symbol)) + (revert-buffer nil t) + (goto-char (point-min)))) + (insert "\n"))))) + + ;;;; Package menu mode. (defvar package-menu-mode-map (let ((map (make-keymap)) (menu-map (make-sparse-keymap "Package"))) (suppress-keymap map) + (define-key map "\C-m" 'package-menu-describe-package) (define-key map "q" 'quit-window) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) @@ -1145,6 +1246,14 @@ (interactive) (package-list-packages-internal)) +(defun package-menu-describe-package () + "Describe the package in the current line." + (interactive) + (let ((name (package-menu-get-package))) + (if name + (describe-package (intern name)) + (message "No package on this line")))) + (defun package-menu-mark-internal (what) (unless (eobp) (let ((buffer-read-only nil)) @@ -1223,7 +1332,7 @@ (save-excursion (beginning-of-line) (if (looking-at ". \\([^ \t]*\\)") - (match-string 1)))) + (match-string-no-properties 1)))) ;; Return the version of the package on the current line. (defun package-menu-get-version () @@ -1279,14 +1388,20 @@ (t ; obsolete, but also the default. 'font-lock-warning-face)))) (insert (propertize " " 'font-lock-face face)) - (insert (propertize (symbol-name package) 'font-lock-face face)) + (insert-text-button (symbol-name package) + 'face 'link + 'follow-link t + 'package-symbol package + 'action (lambda (button) + (describe-package + (button-get button 'package-symbol)))) (indent-to 20 1) (insert (propertize (package-version-join version) 'font-lock-face face)) - (indent-to 30 1) + (indent-to 32 1) (insert (propertize key 'font-lock-face face)) ;; FIXME: this 'when' is bogus... (when desc - (indent-to 41 1) + (indent-to 43 1) (insert (propertize desc 'font-lock-face face))) (insert "\n"))) @@ -1443,11 +1558,6 @@ (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
--- a/lisp/help-mode.el Sat Jun 19 12:15:25 2010 +0000 +++ b/lisp/help-mode.el Sun Jun 20 11:23:04 2010 +0000 @@ -244,6 +244,16 @@ (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find face's definition")) +(define-button-type 'help-package + :supertype 'help-xref + 'help-function 'describe-package + 'help-echo (purecopy "mouse-2, RET: Describe package")) + +(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 ()
--- a/lisp/menu-bar.el Sat Jun 19 12:15:25 2010 +0000 +++ b/lisp/menu-bar.el Sun Jun 20 11:23:04 2010 +0000 @@ -703,6 +703,10 @@ (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")))