[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r112980: * lisp/emacs-lisp/package.el: Don't recompu
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] trunk r112980: * lisp/emacs-lisp/package.el: Don't recompute dir. Use pkg-descs more. |
|
Date: |
Fri, 14 Jun 2013 03:20:33 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 112980
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2013-06-13 23:20:18 -0400
message:
* lisp/emacs-lisp/package.el: Don't recompute dir. Use pkg-descs more.
(package-desc): Add `dir' field.
(package-desc-full-name): New function.
(package-load-descriptor): Combine the two arguments. Don't use `load'.
(package-maybe-load-descriptor): Remove.
(package-load-all-descriptors): Just call package-load-descriptor.
(package--disabled-p): New function.
(package-desc-vers, package-desc-doc): Remove aliases.
(package--dir): Remove function.
(package-activate): Check if a package is disabled.
(package-process-define-package): New function, extracted from
define-package.
(define-package): Turn into a place holder.
(package-unpack-single, package-tar-file-info):
Use package--description-file.
(package-compute-transaction): Use package--disabled-p.
(package-download-transaction): Don't call
package-maybe-load-descriptor since they're all loaded anyway.
(package-install): Change argument to be a pkg-desc.
(package-delete): Use a single pkg-desc argument.
(describe-package-1): Use package-desc-dir instead of package--dir.
Use package-desc property instead of package-symbol.
(package-install-button-action): Adjust accordingly.
(package--push): Rewrite.
(package-menu--print-info): Adjust accordingly. Change the ID format
to be a pkg-desc.
(package-menu-describe-package, package-menu-get-status)
(package-menu--find-upgrades, package-menu-mark-upgrades)
(package-menu-execute, package-menu--name-predicate):
Adjust accordingly.
* lisp/startup.el (package--description-file): New function.
(command-line): Use it.
* lisp/emacs-lisp/package-x.el (package-upload-buffer-internal):
Use package-desc-version.
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/emacs-lisp/package-x.el packagex.el-20100617020707-ybavz666awsxwin6-1
lisp/emacs-lisp/package.el package.el-20100617020707-ybavz666awsxwin6-2
lisp/startup.el startup.el-20091113204419-o5vbwnq5f7feedwu-260
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-06-14 02:31:28 +0000
+++ b/lisp/ChangeLog 2013-06-14 03:20:18 +0000
@@ -1,5 +1,40 @@
2013-06-14 Stefan Monnier <address@hidden>
+ * emacs-lisp/package.el: Don't recompute dir. Use pkg-descs more.
+ (package-desc): Add `dir' field.
+ (package-desc-full-name): New function.
+ (package-load-descriptor): Combine the two arguments. Don't use `load'.
+ (package-maybe-load-descriptor): Remove.
+ (package-load-all-descriptors): Just call package-load-descriptor.
+ (package--disabled-p): New function.
+ (package-desc-vers, package-desc-doc): Remove aliases.
+ (package--dir): Remove function.
+ (package-activate): Check if a package is disabled.
+ (package-process-define-package): New function, extracted from
+ define-package.
+ (define-package): Turn into a place holder.
+ (package-unpack-single, package-tar-file-info):
+ Use package--description-file.
+ (package-compute-transaction): Use package--disabled-p.
+ (package-download-transaction): Don't call
+ package-maybe-load-descriptor since they're all loaded anyway.
+ (package-install): Change argument to be a pkg-desc.
+ (package-delete): Use a single pkg-desc argument.
+ (describe-package-1): Use package-desc-dir instead of package--dir.
+ Use package-desc property instead of package-symbol.
+ (package-install-button-action): Adjust accordingly.
+ (package--push): Rewrite.
+ (package-menu--print-info): Adjust accordingly. Change the ID format
+ to be a pkg-desc.
+ (package-menu-describe-package, package-menu-get-status)
+ (package-menu--find-upgrades, package-menu-mark-upgrades)
+ (package-menu-execute, package-menu--name-predicate):
+ Adjust accordingly.
+ * startup.el (package--description-file): New function.
+ (command-line): Use it.
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Use package-desc-version.
+
* emacs-lisp/bytecomp.el (byte-compile-force-lexical-warnings): New var.
(byte-compile-preprocess): Use it.
(byte-compile-file-form-defalias): Try a bit harder to use macros we
=== modified file 'lisp/emacs-lisp/package-x.el'
--- a/lisp/emacs-lisp/package-x.el 2013-06-12 00:49:33 +0000
+++ b/lisp/emacs-lisp/package-x.el 2013-06-14 03:20:18 +0000
@@ -224,7 +224,7 @@
(let ((elt (assq pkg-name (cdr contents))))
(if elt
(if (version-list-<= split-version
- (package-desc-vers (cdr elt)))
+ (package-desc-version (cdr elt)))
(error "New package has smaller version: %s" pkg-version)
(setcdr elt new-desc))
(setq contents (cons (car contents)
=== modified file 'lisp/emacs-lisp/package.el'
--- a/lisp/emacs-lisp/package.el 2013-06-12 00:49:33 +0000
+++ b/lisp/emacs-lisp/package.el 2013-06-14 03:20:18 +0000
@@ -336,13 +336,22 @@
either `single' or `tar'.
`archive' The name of the archive (as a string) whence this
-package came."
+package came.
+
+`dir' The directory where the package is installed (if installed)."
name
version
(summary package--default-summary)
reqs
kind
- archive)
+ archive
+ dir)
+
+;; Pseudo fields.
+(defsubst package-desc-full-name (pkg-desc)
+ (format "%s-%s"
+ (package-desc-name pkg-desc)
+ (package-version-join (package-desc-version pkg-desc))))
;; Package descriptor format used in finder-inf.el and package--builtins.
(cl-defstruct (package--bi-desc
@@ -422,17 +431,18 @@
(if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname)
(match-string 1 dirname)))
-(defun package-load-descriptor (dir package)
- "Load the description file in directory DIR for package PACKAGE.
-Here, PACKAGE is a string of the form NAME-VERSION, where NAME is
-the package name and VERSION is its version."
- (let* ((pkg-dir (expand-file-name package dir))
- (pkg-file (expand-file-name
- (concat (package-strip-version package) "-pkg")
- pkg-dir)))
- (when (and (file-directory-p pkg-dir)
- (file-exists-p (concat pkg-file ".el")))
- (load pkg-file nil t))))
+(defun package-load-descriptor (pkg-dir)
+ "Load the description file in directory PKG-DIR."
+ (let ((pkg-file (expand-file-name (package--description-file pkg-dir)
+ pkg-dir)))
+ (when (file-exists-p pkg-file)
+ (with-temp-buffer
+ (insert-file-contents pkg-file)
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (let ((pkg-desc (package-process-define-package
+ (read (current-buffer)) pkg-file)))
+ (setf (package-desc-dir pkg-desc) pkg-dir))))))
(defun package-load-all-descriptors ()
"Load descriptors for installed Emacs Lisp packages.
@@ -443,65 +453,34 @@
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist' and `package-obsolete-alist'."
- (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'")))
- (dolist (dir (cons package-user-dir package-directory-list))
- (when (file-directory-p dir)
- (dolist (subdir (directory-files dir))
- (when (string-match regexp subdir)
- (package-maybe-load-descriptor (match-string 1 subdir)
- (match-string 2 subdir)
- dir)))))))
-
-(defun package-maybe-load-descriptor (name version dir)
- "Maybe load a specific package from directory DIR.
-NAME and VERSION are the package's name and version strings.
-This function checks `package-load-list', before actually loading
-the package by calling `package-load-descriptor'."
- (let ((force (assq (intern name) package-load-list))
- (subdir (concat name "-" version)))
- (and (file-directory-p (expand-file-name subdir dir))
- ;; Check `package-load-list':
- (cond ((null force)
- (memq 'all package-load-list))
- ((null (setq force (cadr force)))
- nil) ; disabled
- ((eq force t)
- t)
- ((stringp force) ; held
- (version-list-= (version-to-list version)
- (version-to-list force)))
- (t
- (error "Invalid element in `package-load-list'")))
- ;; Actually load the descriptor:
- (package-load-descriptor dir subdir))))
-
-(define-obsolete-function-alias 'package-desc-vers 'package-desc-version
"24.4")
-
-(define-obsolete-function-alias 'package-desc-doc 'package-desc-summary "24.4")
-
-
-(defun package--dir (name version)
- ;; FIXME: Keep this as a field in the package-desc.
- "Return the directory where a package is installed, or nil if none.
-NAME is a symbol and VERSION is a string."
- (let* ((subdir (format "%s-%s" name version))
- (dir-list (cons package-user-dir package-directory-list))
- pkg-dir)
- (while dir-list
- (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))
+ (dolist (dir (cons package-user-dir package-directory-list))
+ (when (file-directory-p dir)
+ (dolist (subdir (directory-files dir))
+ (let ((pkg-dir (expand-file-name subdir dir)))
+ (when (file-directory-p pkg-dir)
+ (package-load-descriptor pkg-dir)))))))
+
+(defun package-disabled-p (pkg-name version)
+ "Return whether PKG-NAME at VERSION can be activated.
+The decision is made according to `package-load-list'.
+Return nil if the package can be activated.
+Return t if the package is completely disabled.
+Return the max version (as a string) if the package is held at a lower
version."
+ (let ((force (assq pkg-name package-load-list)))
+ (cond ((null force) (not (memq 'all package-load-list)))
+ ((null (setq force (cadr force))) t) ; disabled
+ ((eq force t) nil)
+ ((stringp force) ; held
+ (unless (version-list-= version (version-to-list force))
+ force))
+ (t (error "Invalid element in `package-load-list'")))))
(defun package-activate-1 (pkg-desc)
(let* ((name (package-desc-name pkg-desc))
- (version-str (package-version-join (package-desc-version pkg-desc)))
- (pkg-dir (package--dir name version-str)))
+ (pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
- (error "Internal error: unable to find directory for `%s-%s'"
- name version-str))
+ (error "Internal error: unable to find directory for `%s'"
+ (package-desc-full-name pkg-desc)))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
@@ -553,6 +532,8 @@
;; If the package is already activated, just return t.
((memq package package-activated-list)
t)
+ ;; If it's disabled, then just skip it.
+ ((package-disabled-p package available-version) nil)
;; Otherwise, proceed with activation.
(t
(let ((fail (catch 'dep-failure
@@ -593,29 +574,32 @@
where OTHER-VERSION is a string.
EXTRA-PROPERTIES is currently unused."
- (let* ((name (intern name-string))
- (version (version-to-list version-string))
- (new-pkg-desc (cons name
- (package-desc-from-define name-string
- version-string
- docstring
- requirements)))
- (old-pkg (assq name package-alist)))
+ ;; FIXME: Placeholder! Should we keep it?
+ (error "Don't call me!"))
+
+(defun package-process-define-package (exp origin)
+ (unless (eq (car-safe exp) 'define-package)
+ (error "Can't find define-package in %s" origin))
+ (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
+ (name (package-desc-name new-pkg-desc))
+ (version (package-desc-version new-pkg-desc))
+ (old-pkg (assq name package-alist)))
(cond
;; If there's no old package, just add this to `package-alist'.
((null old-pkg)
- (push new-pkg-desc package-alist))
+ (push (cons name new-pkg-desc) package-alist))
((version-list-< (package-desc-version (cdr old-pkg)) version)
;; Remove the old package and declare it obsolete.
(package-mark-obsolete name (cdr old-pkg))
- (setq package-alist (cons new-pkg-desc
+ (setq package-alist (cons (cons name new-pkg-desc)
(delq old-pkg package-alist))))
;; You can have two packages with the same version, e.g. one in
;; the system package directory and one in your private
;; directory. We just let the first one win.
((not (version-list-= (package-desc-version (cdr old-pkg)) version))
;; The package is born obsolete.
- (package-mark-obsolete name (cdr new-pkg-desc))))))
+ (package-mark-obsolete name new-pkg-desc)))
+ new-pkg-desc))
;; From Emacs 22.
(defun package-autoload-ensure-default-file (file)
@@ -711,7 +695,8 @@
(version-to-list version)))
package-user-dir))
(el-file (expand-file-name (format "%s.el" name) pkg-dir))
- (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir)))
+ (pkg-file (expand-file-name (package--description-file pkg-dir)
+ pkg-dir)))
(make-directory pkg-dir t)
(package--write-file-no-coding el-file)
(let ((print-level nil)
@@ -828,20 +813,15 @@
;; A package is required, but not installed. It might also be
;; blocked via `package-load-list'.
(let ((pkg-desc (cdr (assq next-pkg package-archive-contents)))
- hold)
- (when (setq hold (assq next-pkg package-load-list))
- (setq hold (cadr hold))
- (cond ((eq hold t))
- ((eq hold nil)
- (error "Required package '%s' is disabled"
- (symbol-name next-pkg)))
- ((null (stringp hold))
- (error "Invalid element in `package-load-list'"))
- ((version-list-< (version-to-list hold) next-version)
- (error "Package `%s' held at version %s, \
+ (disabled (package-disabled-p next-pkg next-version)))
+ (when disabled
+ (if (stringp disabled)
+ (error "Package `%s' held at version %s, \
but version %s required"
- (symbol-name next-pkg) hold
- (package-version-join next-version)))))
+ (symbol-name next-pkg) disabled
+ (package-version-join next-version))
+ (error "Required package '%s' is disabled"
+ (symbol-name next-pkg))))
(unless pkg-desc
(error "Package `%s-%s' is unavailable"
(symbol-name next-pkg)
@@ -954,6 +934,7 @@
This function assumes that all package requirements in
PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
using `package-compute-transaction'."
+ ;; FIXME: make package-list a list of pkg-desc.
(dolist (elt package-list)
(let* ((desc (cdr (assq elt package-archive-contents)))
;; As an exception, if package is "held" in
@@ -974,15 +955,13 @@
;; If package A depends on package B, then A may `require' B
;; during byte compilation. So we need to activate B before
;; unpacking A.
- (package-maybe-load-descriptor (symbol-name elt) v-string
- package-user-dir)
(package-activate elt (version-to-list v-string)))))
;;;###autoload
-(defun package-install (name)
- "Install the package named NAME.
-NAME should be the name of one of the available packages in an
-archive in `package-archives'. Interactively, prompt for NAME."
+(defun package-install (pkg-desc)
+ "Install the package PKG-DESC.
+PKG-DESC should be one of the available packages in an
+archive in `package-archives'. Interactively, prompt for its name."
(interactive
(progn
;; Initialize the package system to get the list of package
@@ -991,20 +970,22 @@
(package-initialize t))
(unless package-archive-contents
(package-refresh-contents))
- (list (intern (completing-read
- "Install package: "
- (mapcar (lambda (elt)
- (cons (symbol-name (car elt))
- nil))
- package-archive-contents)
- nil t)))))
- (let ((pkg-desc (assq name package-archive-contents)))
- (unless pkg-desc
- (error "Package `%s' is not available for installation"
- (symbol-name name)))
- (package-download-transaction
- (package-compute-transaction (list name)
- (package-desc-reqs (cdr pkg-desc))))))
+ (let* ((name (intern (completing-read
+ "Install package: "
+ (mapcar (lambda (elt)
+ (cons (symbol-name (car elt))
+ nil))
+ package-archive-contents)
+ nil t)))
+ (pkg-desc (cdr (assq name package-archive-contents))))
+ (unless pkg-desc
+ (error "Package `%s' is not available for installation"
+ name))
+ (list pkg-desc))))
+ (package-download-transaction
+ ;; FIXME: Use (list pkg-desc) instead of just the name.
+ (package-compute-transaction (list (package-desc-name pkg-desc))
+ (package-desc-reqs pkg-desc))))
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
@@ -1055,31 +1036,28 @@
"Find package information for a tar file.
FILE is the name of the tar file to examine.
The return result is a vector like `package-buffer-info'."
- (let ((default-directory (file-name-directory file))
- (file (file-name-nondirectory file)))
- (unless (string-match (concat "\\`" package-subdirectory-regexp
"\\.tar\\'")
- file)
- (error "Invalid package name `%s'" file))
- (let* ((pkg-name (match-string-no-properties 1 file))
- (pkg-version (match-string-no-properties 2 file))
- ;; Extract the package descriptor.
- (pkg-def-contents (shell-command-to-string
- ;; Requires GNU tar.
- (concat "tar -xOf " file " "
- pkg-name "-" pkg-version "/"
- pkg-name "-pkg.el")))
- (pkg-def-parsed (package-read-from-string pkg-def-contents)))
- (unless (eq (car pkg-def-parsed) 'define-package)
- (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
- (let ((pkg-desc
- (apply #'package-desc-from-define (append (cdr pkg-def-parsed)
- '(:kind tar)))))
- (unless (equal pkg-version
- (package-version-join (package-desc-version pkg-desc)))
- (error "Package has inconsistent versions"))
- (unless (equal pkg-name (symbol-name (package-desc-name pkg-desc)))
- (error "Package has inconsistent names"))
- pkg-desc))))
+ (let* ((default-directory (file-name-directory file))
+ (file (file-name-nondirectory file))
+ (dir-name
+ (if (string-match "\\.tar\\'" file)
+ (substring file 0 (match-beginning 0))
+ (error "Invalid package name `%s'" file)))
+ (desc-file (package--description-file dir-name))
+ ;; Extract the package descriptor.
+ (pkg-def-contents (shell-command-to-string
+ ;; Requires GNU tar.
+ (concat "tar -xOf " file " "
+ dir-name "/" desc-file)))
+ (pkg-def-parsed (package-read-from-string pkg-def-contents)))
+ (unless (eq (car pkg-def-parsed) 'define-package)
+ (error "Can't find define-package in %s" desc-file))
+ (let ((pkg-desc
+ (apply #'package-desc-from-define (append (cdr pkg-def-parsed)
+ '(:kind tar)))))
+ (unless (equal dir-name (package-desc-full-name pkg-desc))
+ ;; FIXME: Shouldn't this just be a message/warning?
+ (error "Package has inconsistent name"))
+ pkg-desc)))
;;;###autoload
@@ -1123,17 +1101,17 @@
(package-install-from-buffer (package-tar-file-info file)))
(t (error "Unrecognized extension `%s'" (file-name-extension file))))))
-(defun package-delete (name version)
- (let ((dir (package--dir name version)))
+(defun package-delete (pkg-desc)
+ (let ((dir (package-desc-dir pkg-desc)))
(if (string-equal (file-name-directory dir)
(file-name-as-directory
(expand-file-name package-user-dir)))
(progn
(delete-directory dir t t)
- (message "Package `%s-%s' deleted." name version))
+ (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))
;; Don't delete "system" packages
- (error "Package `%s-%s' is a system package, not deleting"
- name version))))
+ (error "Package `%s' is a system package, not deleting"
+ (package-desc-full-name pkg-desc)))))
(defun package-archive-base (name)
"Return the archive containing the package NAME."
@@ -1212,7 +1190,7 @@
"Describe package: ")
packages nil t nil nil guess))
(list (if (equal val "") guess (intern val)))))
- (if (or (null package) (not (symbolp package)))
+ (if (not (and package (symbolp package)))
(message "No package specified")
(help-setup-xref (list #'describe-package package)
(called-interactively-p 'interactive))
@@ -1231,7 +1209,7 @@
;; Loaded packages are in `package-alist'.
((setq desc (cdr (assq package package-alist)))
(setq version (package-version-join (package-desc-version desc)))
- (if (setq pkg-dir (package--dir package-name version))
+ (if (setq pkg-dir (package-desc-dir desc))
(insert "an installed package.\n\n")
;; This normally does not happen.
(insert "a deleted package.\n\n")))
@@ -1279,7 +1257,7 @@
:foreground "black")
'link)))
(insert-text-button button-text 'face button-face 'follow-link t
- 'package-symbol package
+ 'package-desc desc
'action 'package-install-button-action)))
(built-in
(insert (propertize "Built-in."
@@ -1343,9 +1321,10 @@
(goto-char (point-max))))))))
(defun package-install-button-action (button)
- (let ((package (button-get button 'package-symbol)))
- (when (y-or-n-p (format "Install package `%s'? " package))
- (package-install package)
+ (let ((pkg-desc (button-get button 'package-desc)))
+ (when (y-or-n-p (format "Install package `%s'? "
+ (package-desc-full-name pkg-desc)))
+ (package-install pkg-desc)
(revert-buffer nil t)
(goto-char (point-min)))))
@@ -1434,29 +1413,26 @@
(setq tabulated-list-sort-key (cons "Status" nil))
(tabulated-list-init-header))
-(defmacro package--push (package desc status listname)
+(defmacro package--push (pkg-desc status listname)
"Convenience macro for `package-menu--generate'.
If the alist stored in the symbol LISTNAME lacks an entry for a
-package PACKAGE with descriptor DESC, add one. The alist is
-keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is
-a symbol and VERSION-LIST is a version list."
- `(let* ((version (package-desc-version ,desc))
- (key (cons ,package version)))
- (unless (assoc key ,listname)
- (push (list key ,status (package-desc-summary ,desc)) ,listname))))
+package PKG-DESC, add one. The alist is keyed with PKG-DESC."
+ `(unless (assoc ,pkg-desc ,listname)
+ ;; FIXME: Should we move status into pkg-desc?
+ (push (cons ,pkg-desc ,status) ,listname)))
(defun package-menu--generate (remember-pos packages)
"Populate the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display."
- ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
+ ;; Construct list of (PKG-DESC . STATUS).
(let (info-list name)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
- (package--push name (cdr elt)
+ (package--push (cdr elt)
(if (stringp (cadr (assq name package-load-list)))
"held" "installed")
info-list)))
@@ -1466,14 +1442,14 @@
(setq name (car elt))
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or (eq packages t) (memq name packages)))
- (package--push name (package--from-builtin elt) "built-in" info-list)))
+ (package--push (package--from-builtin elt) "built-in" info-list)))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
(let ((hold (assq name package-load-list)))
- (package--push name (cdr elt)
+ (package--push (cdr elt)
(cond
((and hold (null (cadr hold))) "disabled")
((memq name package-menu--new-package-list) "new")
@@ -1484,7 +1460,7 @@
(dolist (elt package-obsolete-alist)
(dolist (inner-elt (cdr elt))
(when (or (eq packages t) (memq (car elt) packages))
- (package--push (car elt) (cdr inner-elt) "obsolete" info-list))))
+ (package--push (cdr inner-elt) "obsolete" info-list))))
;; Print the result.
(setq tabulated-list-entries (mapcar 'package-menu--print-info info-list))
@@ -1492,31 +1468,30 @@
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
-PKG has the form ((PACKAGE . VERSION) STATUS DOC).
-Return (KEY [NAME VERSION STATUS DOC]), where KEY is the
-identifier (NAME . VERSION-LIST)."
- (let* ((package (caar pkg))
- (version (cdr (car pkg)))
- (status (nth 1 pkg))
- (doc (or (nth 2 pkg) ""))
- (face (cond
- ((string= status "built-in") 'font-lock-builtin-face)
- ((string= status "available") 'default)
- ((string= status "new") 'bold)
- ((string= status "held") 'font-lock-constant-face)
- ((string= status "disabled") 'font-lock-warning-face)
- ((string= status "installed") 'font-lock-comment-face)
- (t 'font-lock-warning-face)))) ; obsolete.
- (list (cons package version)
- (vector (list (symbol-name package)
+PKG has the form (PKG-DESC . STATUS).
+Return (PKG-DESC [NAME VERSION STATUS DOC])."
+ (let* ((pkg-desc (car pkg))
+ (status (cdr pkg))
+ (face (pcase status
+ (`"built-in" 'font-lock-builtin-face)
+ (`"available" 'default)
+ (`"new" 'bold)
+ (`"held" 'font-lock-constant-face)
+ (`"disabled" 'font-lock-warning-face)
+ (`"installed" 'font-lock-comment-face)
+ (_ 'font-lock-warning-face)))) ; obsolete.
+ (list pkg-desc
+ (vector (list (symbol-name (package-desc-name pkg-desc))
'face 'link
'follow-link t
- 'package-symbol package
+ 'package-desc pkg-desc
'action 'package-menu-describe-package)
- (propertize (package-version-join version)
+ (propertize (package-version-join
+ (package-desc-version pkg-desc))
'font-lock-face face)
(propertize status 'font-lock-face face)
- (propertize doc 'font-lock-face face)))))
+ (propertize (package-desc-summary pkg-desc)
+ 'font-lock-face face)))))
(defun package-menu-refresh ()
"Download the Emacs Lisp package archive.
@@ -1532,10 +1507,11 @@
"Describe the current package.
If optional arg BUTTON is non-nil, describe its associated package."
(interactive)
- (let ((package (if button (button-get button 'package-symbol)
- (car (tabulated-list-get-id)))))
- (if package
- (describe-package package))))
+ (let ((pkg-desc (if button (button-get button 'package-desc)
+ (car (tabulated-list-get-id)))))
+ (if pkg-desc
+ ;; FIXME: We could actually describe this particular pkg-desc.
+ (describe-package (package-desc-name pkg-desc)))))
;; fixme numeric argument
(defun package-menu-mark-delete (&optional _num)
@@ -1582,8 +1558,8 @@
'package-menu-view-commentary 'package-menu-describe-package "24.1")
(defun package-menu-get-status ()
- (let* ((pkg (tabulated-list-get-id))
- (entry (and pkg (assq pkg tabulated-list-entries))))
+ (let* ((id (tabulated-list-get-id))
+ (entry (and id (assq id tabulated-list-entries))))
(if entry
(aref (cadr entry) 2)
"")))
@@ -1592,18 +1568,20 @@
(let (installed available upgrades)
;; Build list of installed/available packages in this buffer.
(dolist (entry tabulated-list-entries)
- ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
- (let ((pkg (car entry))
+ ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
+ (let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
(cond ((equal status "installed")
- (push pkg installed))
+ (push pkg-desc installed))
((member status '("available" "new"))
- (push pkg available)))))
- ;; Loop through list of installed packages, finding upgrades
- (dolist (pkg installed)
- (let ((avail-pkg (assq (car pkg) available)))
+ (push (cons (package-desc-name pkg-desc) pkg-desc)
+ available)))))
+ ;; Loop through list of installed packages, finding upgrades.
+ (dolist (pkg-desc installed)
+ (let ((avail-pkg (assq (package-desc-name pkg-desc) available)))
(and avail-pkg
- (version-list-< (cdr pkg) (cdr avail-pkg))
+ (version-list-< (package-desc-version pkg-desc)
+ (package-desc-version (cdr avail-pkg)))
(push avail-pkg upgrades))))
upgrades))
@@ -1623,11 +1601,11 @@
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (let* ((pkg (tabulated-list-get-id))
- (upgrade (assq (car pkg) upgrades)))
+ (let* ((pkg-desc (tabulated-list-get-id))
+ (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
(cond ((null upgrade)
(forward-line 1))
- ((equal pkg upgrade)
+ ((equal pkg-desc upgrade)
(package-menu-mark-install))
(t
(package-menu-mark-delete))))))
@@ -1643,30 +1621,30 @@
(interactive)
(unless (derived-mode-p 'package-menu-mode)
(error "The current buffer is not in Package Menu mode"))
- (let (install-list delete-list cmd id)
+ (let (install-list delete-list cmd pkg-desc)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(setq cmd (char-after))
(unless (eq cmd ?\s)
- ;; This is the key (PACKAGE . VERSION-LIST).
- (setq id (tabulated-list-get-id))
+ ;; This is the key PKG-DESC.
+ (setq pkg-desc (tabulated-list-get-id))
(cond ((eq cmd ?D)
- (push (cons (symbol-name (car id))
- (package-version-join (cdr id)))
- delete-list))
+ (push pkg-desc delete-list))
((eq cmd ?I)
- (push (car id) install-list))))
+ (push pkg-desc install-list))))
(forward-line)))
(when install-list
(if (or
noquery
(yes-or-no-p
- (if (= (length install-list) 1)
- (format "Install package `%s'? " (car install-list))
- (format "Install these %d packages (%s)? "
- (length install-list)
- (mapconcat 'symbol-name install-list ", ")))))
+ (if (= (length install-list) 1)
+ (format "Install package `%s'? "
+ (package-desc-full-name (car install-list)))
+ (format "Install these %d packages (%s)? "
+ (length install-list)
+ (mapconcat #'package-desc-full-name
+ install-list ", ")))))
(mapc 'package-install install-list)))
;; Delete packages, prompting if necessary.
(when delete-list
@@ -1674,18 +1652,15 @@
noquery
(yes-or-no-p
(if (= (length delete-list) 1)
- (format "Delete package `%s-%s'? "
- (caar delete-list)
- (cdr (car delete-list)))
+ (format "Delete package `%s'? "
+ (package-desc-full-name (car delete-list)))
(format "Delete these %d packages (%s)? "
(length delete-list)
- (mapconcat (lambda (elt)
- (concat (car elt) "-" (cdr elt)))
- delete-list
- ", ")))))
+ (mapconcat #'package-desc-full-name
+ delete-list ", ")))))
(dolist (elt delete-list)
(condition-case-unless-debug err
- (package-delete (car elt) (cdr elt))
+ (package-delete elt)
(error (message (cadr err)))))
(error "Aborted")))
;; If we deleted anything, regenerate `package-alist'. This is done
@@ -1730,8 +1705,8 @@
(string< dA dB))))
(defun package-menu--name-predicate (A B)
- (string< (symbol-name (caar A))
- (symbol-name (caar B))))
+ (string< (symbol-name (package-desc-name (car A)))
+ (symbol-name (package-desc-name (car B)))))
;;;###autoload
(defun list-packages (&optional no-fetch)
=== modified file 'lisp/startup.el'
--- a/lisp/startup.el 2013-06-13 17:59:10 +0000
+++ b/lisp/startup.el 2013-06-14 03:20:18 +0000
@@ -422,6 +422,13 @@
The regexp should not contain a starting \"\\`\" or a trailing
\"\\'\"; those are added automatically by callers.")
+(defun package--description-file (dir)
+ (concat (let ((subdir (file-name-nondirectory
+ (directory-file-name dir))))
+ (if (string-match package-subdirectory-regexp subdir)
+ (match-string 1 subdir) subdir))
+ "-pkg.el"))
+
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of `default-directory' to `load-path'.
More precisely, this uses only the subdirectories whose names
@@ -1194,10 +1201,10 @@
(dolist (dir dirs)
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
- (when (and (file-directory-p (expand-file-name subdir dir))
- (string-match
- (concat "\\`" package-subdirectory-regexp "\\'")
- subdir))
+ (when (let ((subdir (expand-file-name subdir dir)))
+ (and (file-directory-p subdir)
+ (file-exists-p
+ (package--description-file subdir))))
(throw 'package-dir-found t)))))))
(package-initialize))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r112980: * lisp/emacs-lisp/package.el: Don't recompute dir. Use pkg-descs more.,
Stefan Monnier <=