diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 19 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package-x.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 76 |
3 files changed, 75 insertions, 23 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3da4cef6952..3e689f443ce 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,22 @@ +2013-09-29 Dmitry Gutov <dgutov@yandex.ru> + + * emacs-lisp/package.el (package-desc-from-define): Accept + additional arguments as plist, convert it to an alist and store it + in the `extras' slot. + (package-generate-description-file): Convert extras alist back to + plist and append to the `define-package' form arguments. + (package--alist-to-plist): New function. + (package--ac-desc): Add `extras' slot. + (package--add-to-archive-contents): Check if the archive-contents + vector is long enough, and if it is, pass its `extras' slot value + to `package-desc-create'. + (package-buffer-info): Call `lm-homepage', pass the returned value + to `package-desc-from-define'. + (describe-package-1): Render the homepage button (Bug#13291). + + * emacs-lisp/package-x.el (package-upload-buffer-internal): Pass + `extras' slot from `package-desc' to `package-make-ac-desc'. + 2013-09-29 Jan Djärv <jan.h.d@swipnet.se> * term/ns-win.el (ns-initialize-window-system): Set locale-coding-system diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 76d7565d64b..11053158d3e 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -209,6 +209,7 @@ if it exists." (pcase file-type (`single (lm-commentary)) (`tar nil))) ;; FIXME: Get it from the README file. + (extras (package-desc-extras pkg-desc)) (pkg-version (package-version-join split-version)) (pkg-buffer (current-buffer))) @@ -217,7 +218,7 @@ if it exists." (let ((contents (or (package--archive-contents-from-url archive-url) (package--archive-contents-from-file))) (new-desc (package-make-ac-desc - split-version requires desc file-type))) + split-version requires desc file-type extras))) (if (> (car contents) package-archive-version) (error "Unrecognized archive version %d" (car contents))) (let ((elt (assq pkg-name (cdr contents)))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 77496bad441..785263789b0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -296,7 +296,7 @@ contrast, `package-user-dir' contains packages for personal use." (:constructor package-desc-from-define (name-string version-string &optional summary requirements - &key kind archive &allow-other-keys + &rest rest-plist &aux (name (intern name-string)) (version (version-to-list version-string)) @@ -305,7 +305,19 @@ contrast, `package-user-dir' contains packages for personal use." (version-to-list (cadr elt)))) (if (eq 'quote (car requirements)) (nth 1 requirements) - requirements)))))) + requirements))) + (kind (plist-get rest-plist :kind)) + (archive (plist-get rest-plist :archive)) + (extras (let (alist) + (cl-remf rest-plist :kind) + (cl-remf rest-plist :archive) + (while rest-plist + (let ((value (cadr rest-plist))) + (when value + (push (cons (car rest-plist) value) + alist))) + (setq rest-plist (cddr rest-plist))) + alist))))) "Structure containing information about an individual package. Slots: @@ -327,14 +339,17 @@ Slots: package came. `dir' The directory where the package is installed (if installed), - `builtin' if it is built-in, or nil otherwise." + `builtin' if it is built-in, or nil otherwise. + +`extras' Optional alist of additional keyword-value pairs." name version (summary package--default-summary) reqs kind archive - dir) + dir + extras) ;; Pseudo fields. (defun package-desc-full-name (pkg-desc) @@ -642,22 +657,28 @@ untar into a directory named DIR; otherwise, signal an error." (write-region (concat (prin1-to-string - (list 'define-package - (symbol-name name) - (package-version-join (package-desc-version pkg-desc)) - (package-desc-summary pkg-desc) - (let ((requires (package-desc-reqs pkg-desc))) - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires))))) + (nconc + (list 'define-package + (symbol-name name) + (package-version-join (package-desc-version pkg-desc)) + (package-desc-summary pkg-desc) + (let ((requires (package-desc-reqs pkg-desc))) + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + requires)))) + (package--alist-to-plist + (package-desc-extras pkg-desc)))) "\n") nil pkg-file)))) +(defun package--alist-to-plist (alist) + (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))) + (defun package-unpack (pkg-desc) "Install the contents of the current buffer as a package." (let* ((name (package-desc-name pkg-desc)) @@ -893,10 +914,10 @@ If the archive version is too new, signal an error." ;; Changing this defstruct implies changing the format of the ;; "archive-contents" files. (cl-defstruct (package--ac-desc - (:constructor package-make-ac-desc (version reqs summary kind)) + (:constructor package-make-ac-desc (version reqs summary kind extras)) (:copier nil) (:type vector)) - version reqs summary kind) + version reqs summary kind extras) (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. @@ -911,7 +932,11 @@ Also, add the originating archive to the `package-desc' structure." :reqs (package--ac-desc-reqs (cdr package)) :summary (package--ac-desc-summary (cdr package)) :kind (package--ac-desc-kind (cdr package)) - :archive archive)) + :archive archive + :extras (and (> (length (cdr package)) 4) + ;; Older archive-contents files have only 4 + ;; elements here. + (package--ac-desc-extras (cdr package))))) (existing-packages (assq name package-archive-contents)) (pinned-to-archive (assoc name package-pinned-packages))) (cond @@ -1004,14 +1029,16 @@ boundaries." ;; probably wants us to use it. Otherwise try Version. (pkg-version (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version"))))) + (package-strip-rcs-id (lm-header "version")))) + (homepage (lm-homepage))) (unless pkg-version (error "Package lacks a \"Version\" or \"Package-Version\" header")) (package-desc-from-define file-name pkg-version desc (if requires-str (package-read-from-string requires-str)) - :kind 'single)))) + :kind 'single + :homepage homepage)))) (declare-function tar-get-file-descriptor "tar-mode" (file)) (declare-function tar--extract "tar-mode" (descriptor)) @@ -1180,6 +1207,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (reqs (if desc (package-desc-reqs desc))) (version (if desc (package-desc-version desc))) (archive (if desc (package-desc-archive desc))) + (homepage (if desc (cdr (assoc :homepage + (package-desc-extras desc))))) (built-in (eq pkg-dir 'builtin)) (installable (and archive (not built-in))) (status (if desc (package-desc-status desc) "orphan"))) @@ -1248,7 +1277,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) ": " (if desc (package-desc-summary desc)) "\n") - + (when homepage + (insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ") + (help-insert-xref-button homepage 'help-url homepage) + (insert "\n")) (let* ((all-pkgs (append (cdr (assq name package-alist)) (cdr (assq name package-archive-contents)) (let ((bi (assq name package--builtins))) |