diff --git a/core/libs/quelpa.el b/core/libs/quelpa.el index 6c6b49100..84b01be8a 100644 --- a/core/libs/quelpa.el +++ b/core/libs/quelpa.el @@ -286,13 +286,25 @@ if no action is necessary (like when the package is installed already and should not be upgraded etc)." (let* ((name (car rcp)) (build-dir (expand-file-name (symbol-name name) quelpa-build-dir)) - (version (quelpa-checkout rcp build-dir))) + (ver-type (plist-get (cdr rcp) :version-type)) + (files (quelpa-build--config-file-list (cdr rcp))) + (melpa-ver (quelpa-checkout rcp build-dir)) + (version + (cond + ((or (not (equal ver-type 'elpa)) quelpa-stable-p) melpa-ver) + (t + (let ((base-ver + (if-let ((info (quelpa-build--pkg-info (symbol-name name) files build-dir))) + (aref info 3) + '(0 0 0)))) + (while (< (length base-ver) 3) (setq base-ver (append base-ver '(0)))) + (concat (package-version-join base-ver) "." melpa-ver)))))) (prog1 (if version (quelpa-archive-file-name (quelpa-build-package (symbol-name name) version - (quelpa-build--config-file-list (cdr rcp)) + files build-dir quelpa-packages-dir)) (quelpa-build--message "Newer package has been installed. Not upgrading.") @@ -411,9 +423,8 @@ and return TIME-STAMP, otherwise return OLD-TIME-STAMP." "When non-nil, then print additional progress information." :type 'boolean) -(defcustom quelpa-build-stable nil - "When non-nil, then try to build packages from versions-tagged code." - :type 'boolean) +(defvar quelpa-build-stable nil + "When non-nil, then try to build packages from versions-tagged code.") (defcustom quelpa-build-timeout-executable (let ((prog (or (executable-find "timeout") @@ -509,7 +520,7 @@ or nil if the version cannot be parsed." (ignore-errors (version-to-list str))) (defun quelpa-build--parse-time (str) - "Parse STR as a time, and format as a YYYYMMDD.HHMM string." + "Parse STR as a time, and format as a YYYYMMDD.HHMMSS string." ;; We remove zero-padding the HH portion, as it is lost ;; when stored in the archive-contents (setq str (substring-no-properties str)) @@ -520,8 +531,9 @@ or nil if the version cannot be parsed." (concat (match-string 1 str) "-" (match-string 2 str) "-" (match-string 3 str) " " (match-string 4 str)) str)))) - (concat (format-time-string "%Y%m%d." time) - (format "%d" (string-to-number (format-time-string "%H%M" time)))))) + (replace-regexp-in-string + "\\.0+" "." + (format-time-string "%Y%m%d.%H%M%S" time)))) (defun quelpa-build--find-parse-time (regexp &optional bound) "Find REGEXP in current buffer and format as a time-based version string. @@ -1272,18 +1284,21 @@ Tests and sets variable `quelpa--tar-type' if not already set." (insert trailer) (newline))))) -(defun quelpa-build--get-package-info (file-path) - "Get a vector of package info from the docstrings in FILE-PATH." +(defun quelpa-build--get-package-info (file-path &optional keep-version) + "Get a vector of package info from the docstrings in FILE-PATH. +If KEEP-VERSION is set, don't override with version 0." (when (file-exists-p file-path) (ignore-errors (with-temp-buffer (insert-file-contents file-path) ;; next few lines are a hack for some packages that aren't ;; commented properly. - (quelpa-build--update-or-insert-version "0") (quelpa-build--ensure-ends-here-line file-path) - (cl-flet ((package-strip-rcs-id (str) "0")) - (quelpa-build--package-buffer-info-vec)))))) + (if keep-version + (quelpa-build--package-buffer-info-vec) + (quelpa-build--update-or-insert-version "0") + (cl-flet ((package-strip-rcs-id (str) "0")) + (quelpa-build--package-buffer-info-vec))))))) (defun quelpa-build--get-pkg-file-info (file-path) "Get a vector of package info from \"-pkg.el\" file FILE-PATH." @@ -1292,6 +1307,7 @@ Tests and sets variable `quelpa--tar-type' if not already set." (if (eq 'define-package (car package-def)) (let* ((pkgfile-info (cdr package-def)) (descr (nth 2 pkgfile-info)) + (ver (nth 1 pkgfile-info)) (rest-plist (cl-subseq pkgfile-info (min 4 (length pkgfile-info)))) (extras (let (alist) (while rest-plist @@ -1315,7 +1331,7 @@ Tests and sets variable `quelpa--tar-type' if not already set." (list (car elt) (version-to-list (cadr elt)))) (eval (nth 3 pkgfile-info))) descr - (nth 1 pkgfile-info) + (if (stringp ver) (version-to-list ver) ver) extras)) (error "No define-package found in %s" file-path))))) @@ -1480,30 +1496,18 @@ FILES is a list of (SOURCE . DEST) relative filepath pairs." (car (rassoc target files))) (defun quelpa-build--package-buffer-info-vec () - "Return a vector of package info. -`package-buffer-info' returns a vector in older Emacs versions, -and a cl struct in Emacs HEAD. This wrapper normalises the results." - (let ((desc (package-buffer-info)) - (keywords (lm-keywords-list))) - (if (fboundp 'package-desc-create) - (let ((extras (package-desc-extras desc))) - (when (and keywords (not (assq :keywords extras))) - ;; Add keywords to package properties, if not already present - (push (cons :keywords keywords) extras)) - (vector (package-desc-name desc) - (package-desc-reqs desc) - (package-desc-summary desc) - (package-desc-version desc) - extras)) - (let ((homepage (lm-homepage)) - extras) - (when keywords (push (cons :keywords keywords) extras)) - (when homepage (push (cons :url homepage) extras)) - (vector (aref desc 0) - (aref desc 1) - (aref desc 2) - (aref desc 3) - extras))))) + "Return a vector of package info." + (let* ((desc (package-buffer-info)) + (keywords (lm-keywords-list)) + (extras (package-desc-extras desc))) + (when (and keywords (not (assq :keywords extras))) + ;; Add keywords to package properties, if not already present + (push (cons :keywords keywords) extras)) + (vector (package-desc-name desc) + (package-desc-reqs desc) + (package-desc-summary desc) + (package-desc-version desc) + extras))) ;;; Building @@ -1543,6 +1547,26 @@ Returns the archive entry for the package." package-name version files source-dir target-dir)) (t (error "Unable to find files matching recipe patterns"))))) +(defun quelpa-build--pkg-info (package-name files source-dir) + (pcase files + (`(,file) + (thread-first (expand-file-name file source-dir) + (quelpa-build--get-package-info :keep-version))) + (_ + (let* ((default-directory source-dir) + (pkg-file (concat package-name "-pkg.el")) + (pkg-file-source (or (quelpa-build--find-source-file pkg-file files) + pkg-file)) + (file-source (concat package-name ".el")) + (pkg-source (or (quelpa-build--find-source-file file-source files) + file-source))) + (or (quelpa-build--get-pkg-file-info pkg-file-source) + ;; some packages (like magit) provide name-pkg.el.in + (quelpa-build--get-pkg-file-info + (expand-file-name (concat pkg-file ".in") + (file-name-directory pkg-source))) + (quelpa-build--get-package-info pkg-source :keep-version)))))) + (defun quelpa-build--build-single-file-package (package-name version file source-dir target-dir) (let* ((pkg-source (expand-file-name file source-dir))