TakeV
/
spacemacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update quelpa.el to latest version

This commit is contained in:
Maximilian Wolff 2020-02-24 12:04:19 +01:00
parent fcb79bf55b
commit d10ca8d6d5
No known key found for this signature in database
GPG Key ID: 2DD07025BFDBD89A
1 changed files with 145 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

206
core/libs/quelpa.el
View File

@ -142,11 +142,17 @@ If nil the update is disabled and the repo is only updated on
(defcustom quelpa-self-upgrade-p t
"If non-nil upgrade quelpa itself when doing a
`quelpa-upgrade', otherwise only upgrade the packages in the
quelpa cache."
`quelpa-upgrade-all', otherwise only upgrade the packages in the
quelpa cache."
:group 'quelpa
:type 'boolean)
(defcustom quelpa-git-clone-depth 1
"If non-nil shallow clone quelpa git recipes."
:group 'quelpa
:type '(choice (const :tag "Don't shallow clone" nil)
(integer :tag "Depth")))
(defvar quelpa-initialized-p nil
"Non-nil when quelpa has been initialized.")
@ -210,13 +216,15 @@ On error return nil."
(package-buffer-info))
(`tar (insert-file-contents-literally file)
(tar-mode)
(if (help-function-arglist 'package-tar-file-info)
;; legacy `package-tar-file-info' requires an arg
(package-tar-file-info file)
(with-no-warnings (package-tar-file-info)))))))))
(with-no-warnings
(if (help-function-arglist 'package-tar-file-info)
;; legacy `package-tar-file-info' requires an arg
(package-tar-file-info file)
(package-tar-file-info)))))))))
(pcase desc
((pred package-desc-p) desc)
((pred vectorp) (package-desc-from-legacy desc kind)))))
((pred vectorp) (when (fboundp 'package-desc-from-legacy)
(package-desc-from-legacy desc kind))))))
(defun quelpa-archive-file-name (archive-entry)
"Return the path of the file in which the package for ARCHIVE-ENTRY is stored."
@ -235,24 +243,23 @@ On error return nil."
(and pkg-desc
(version-list-<=
(version-to-list version)
(if (functionp 'package-desc-vers)
(package-desc-vers pkg-desc) ;old implementation
(package-desc-version (car pkg-desc))))))
(package-desc-version (car pkg-desc)))))
;; Also check built-in packages.
(package-built-in-p name (version-to-list version)))))
(defun quelpa-checkout (rcp dir)
"Return the version of the new package given a RCP.
"Return the version of the new package given a RCP and DIR.
Return nil if the package is already installed and should not be upgraded."
(pcase-let ((`(,name . ,config) rcp)
(quelpa-build-stable quelpa-stable-p))
(unless (or (and (assq name package-alist) (not quelpa-upgrade-p))
(and (not config)
(quelpa-message t "no recipe found for package `%s'" name)))
(let ((version (condition-case err
(let ((version (condition-case-unless-debug err
(quelpa-build-checkout name config dir)
(error "Failed to checkout `%s': `%s'"
name (error-message-string err)))))
(error
(error "Failed to checkout `%s': `%s'"
name (error-message-string err))))))
(when (quelpa-version>-p name version)
version)))))
@ -260,7 +267,7 @@ Return nil if the package is already installed and should not be upgraded."
"Build a package from the given recipe RCP.
Uses the `package-build' library to get the source code and build
an elpa compatible package in `quelpa-build-dir' storing it in
`quelpa-packages-dir'. Return the path to the created file or nil
`quelpa-packages-dir'. Return the path to the created file or nil
if no action is necessary (like when the package is installed
already and should not be upgraded etc)."
(let* ((name (car rcp))
@ -308,7 +315,7 @@ already and should not be upgraded etc)."
(mapcar
(lambda (file) (expand-file-name file path))
;; Without first two entries because they are always "." and "..".
(cddr (directory-files path))))
(remove ".." (remove "." (directory-files path)))))
result))
(defun quelpa-expand-source-file-list (file-path config)
@ -415,6 +422,10 @@ if `quelpa-build-timeout-executable' is non-nil."
Certain package names (e.g. \"@\") may not work properly with a BSD tar."
:type '(file :must-match t))
(defvar quelpa--tar-type nil
"Type of `quelpa-build-tar-executable'. Can be `gnu' or `bsd'.
nil means the type is not decided yet.")
(defcustom quelpa-build-explicit-tar-format-p nil
"If non-nil pass \"--format=gnu\" option to tar command.
@ -422,6 +433,7 @@ Passing the option is necessary on the systems where the default
tar format isn't gnu."
:type 'boolean)
(defcustom quelpa-build-version-regexp "^[rRvV]?\\(.*\\)$"
"Default pattern for matching valid version-strings within repository tags.
The string in the capture group should be parsed as valid by `version-to-list'."
@ -488,15 +500,17 @@ or nil if the version cannot be parsed."
(defun quelpa-build--find-parse-time (regexp &optional bound)
"Find REGEXP in current buffer and format as a time-based version string.
An optional second argument bounds the search; it is a buffer
position. The match found must not end after that position."
An optional second argument BOUND bounds the search; it is a
buffer position. The match found must not end after that
position."
(and (re-search-backward regexp bound t)
(quelpa-build--parse-time (match-string-no-properties 1))))
(defun quelpa-build--find-parse-time-newest (regexp &optional bound)
"Find REGEXP in current buffer and format as a time-based version string.
An optional second argument bounds the search; it is a buffer
position. The match found must not end after that position."
An optional second argument BOUND bounds the search; it is a
buffer position. The match found must not end after that
position."
(save-match-data
(let (cur matches)
(while (setq cur (quelpa-build--find-parse-time regexp bound))
@ -505,8 +519,9 @@ position. The match found must not end after that position."
(defun quelpa-build--find-version-newest (regexp &optional bound)
"Find the newest version matching REGEXP before point.
An optional second argument bounds the search; it is a buffer
position. The match found must not before after that position."
An optional second argument BOUND bounds the search; it is a
buffer position. The match found must not before after that
position."
(let ((tags (split-string
(buffer-substring-no-properties
(or bound (point-min)) (point))
@ -544,9 +559,13 @@ position. The match found must not before after that position."
;;; Run Process
(defun quelpa-build--run-process (dir command &rest args)
"In DIR (or `default-directory' if unset) run COMMAND with ARGS.
"In DIR run COMMAND with ARGS.
If DIR is unset, try to run from `quelpa-build-dir'
or variable `temporary-file-directory'.
Output is written to the current buffer."
(let ((default-directory (file-name-as-directory (or dir default-directory)))
(let ((default-directory (file-name-as-directory (or dir
quelpa-build-dir
temporary-file-directory)))
(argv (nconc (unless (eq system-type 'windows-nt)
(list "env" "LC_ALL=C"))
(if quelpa-build-timeout-executable
@ -855,18 +874,21 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
;;;; Git
(defun quelpa-build--git-repo (dir)
"Get the current git repo for DIR."
(defun quelpa-build--git-repo (dir remote)
"Get the current git repo for DIR from REMOTE."
(quelpa-build--run-process-match
"Fetch URL: \\(.*\\)" dir "git" "remote" "show" "-n" "origin"))
"Fetch URL: \\(.*\\)" dir "git" "remote" "show" "-n" remote))
(defun quelpa-build--checkout-git (name config dir)
"Check package NAME with config CONFIG out of git into DIR."
(let ((repo (plist-get config :url))
(commit (or (plist-get config :commit)
(let ((branch (plist-get config :branch)))
(when branch
(concat "origin/" branch))))))
(let* ((repo (plist-get config :url))
(remote (or (plist-get config :remote) "origin"))
(commit (or (plist-get config :commit)
(let ((branch (plist-get config :branch)))
(when branch (concat remote "/" branch)))))
(depth (or (plist-get config :depth) quelpa-git-clone-depth))
(force (plist-get config :force))
(use-current-ref (plist-get config :use-current-ref)))
(when (string-match (rx bos "file://" (group (1+ anything))) repo)
;; Expand local file:// URLs
(setq repo (expand-file-name (match-string 1 repo))))
@ -874,14 +896,22 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
(goto-char (point-max))
(cond
((and (file-exists-p (expand-file-name ".git" dir))
(string-equal (quelpa-build--git-repo dir) repo))
(string-equal (quelpa-build--git-repo dir remote) repo))
(quelpa-build--princ-exists dir)
(quelpa-build--run-process dir "git" "fetch" "--all" "--tags"))
(quelpa-build--run-process dir "git" "fetch" "--tags" remote))
(t
(when (file-exists-p dir)
(delete-directory dir t))
(quelpa-build--princ-checkout repo dir)
(quelpa-build--run-process nil "git" "clone" repo dir)))
(apply #'quelpa-build--run-process
(append
`(nil "git" "clone" ,repo ,dir)
`("--origin" ,remote)
(when (and depth (not (plist-get config :commit)))
`("--depth" ,(int-to-string depth)
"--no-single-branch"))
(let ((branch (plist-get config :branch)))
(when branch `("--branch" ,branch)))))))
(if quelpa-build-stable
(let* ((min-bound (goto-char (point-max)))
(tag-version
@ -893,12 +923,16 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
(error "No valid stable versions found for %s" name)))))
;; Using reset --hard here to comply with what's used for
;; unstable, but maybe this should be a checkout?
(quelpa-build--update-git-to-ref
dir (concat "tags/" (cadr tag-version)))
(unless use-current-ref
(quelpa-build--update-git-to-ref
dir (concat "tags/" (cadr tag-version))
force))
;; Return the parsed version as a string
(package-version-join (car tag-version)))
(quelpa-build--update-git-to-ref
dir (or commit (concat "origin/" (quelpa-build--git-head-branch dir))))
(unless use-current-ref
(quelpa-build--update-git-to-ref
dir (or commit (concat remote "/" (quelpa-build--git-head-branch dir)))
force))
(apply 'quelpa-build--run-process
dir "git" "log" "--first-parent" "-n1" "--pretty=format:'\%ci'"
(quelpa-build--expand-source-file-list dir config))
@ -919,9 +953,18 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
(quelpa-build--run-process-match
"\\(.*\\)" dir "git" "rev-parse" "HEAD")))
(defun quelpa-build--update-git-to-ref (dir ref)
"Update the git repo in DIR so that HEAD is REF."
(quelpa-build--run-process dir "git" "reset" "--hard" ref)
(defun quelpa-build--update-git-to-ref (dir ref &optional force)
"Update the git repo in DIR so that HEAD is REF.
This will perform an checkout or a reset if FORCE."
(condition-case nil
(quelpa-build--run-process dir "git" "cat-file" "-e" ref)
(error
;; unshallow if needed
(quelpa-build--run-process dir "git" "fetch" "--unshallow" "--tags")))
(if force
(quelpa-build--run-process dir "git" "reset" "--hard" ref)
(with-demoted-errors "Error: %s"
(quelpa-build--run-process dir "git" "checkout" ref)))
(quelpa-build--run-process dir "git" "submodule" "sync" "--recursive")
(quelpa-build--run-process dir "git" "submodule" "update" "--init" "--recursive"))
@ -1087,9 +1130,23 @@ Optionally PRETTY-PRINT the data."
(when (file-exists-p file)
(car (read-from-string (quelpa-build--slurp-file file)))))
(defun quelpa--tar-type ()
"Return `bsd' or `gnu' depending on type of Tar executable.
Tests and sets variable `quelpa--tar-type' if not already set."
(or quelpa--tar-type
(when (and quelpa-build-tar-executable
(file-executable-p quelpa-build-tar-executable))
(setq quelpa--tar-type
(let ((v (shell-command-to-string
(format "%s --version" quelpa-build-tar-executable))))
(cond ((string-match-p "bsdtar" v) 'bsd)
((string-match-p "GNU tar" v) 'gnu)
(t 'gnu)))))))
(defun quelpa-build--create-tar (file dir &optional files)
"Create a tar FILE containing the contents of DIR, or just FILES if non-nil."
(when (eq system-type 'windows-nt)
(when (and (eq (quelpa--tar-type) 'gnu)
(eq system-type 'windows-nt))
(setq file (replace-regexp-in-string "^\\([a-z]\\):" "/\\1" file)))
(apply 'process-file
quelpa-build-tar-executable nil
@ -1600,6 +1657,7 @@ Return t in each case."
(insert (prin1-to-string quelpa-cache))))))
(defun quelpa-update-cache (cache-item)
"Update `quelpa-cache' with new CACHE-ITEM."
;; try removing existing recipes by name
(setq quelpa-cache (cl-remove (car cache-item)
quelpa-cache :key #'car))
@ -1617,7 +1675,7 @@ Return t in each case."
(setf (cdr (last cache-item)) '(:stable t))))
(defun quelpa-checkout-melpa ()
"Fetch or update the melpa source code from GitHub.
"Fetch or update the melpa source code from Github.
If there is no error return non-nil.
If there is an error but melpa is already checked out return non-nil.
If there is an error and no existing checkout return nil."
@ -1628,7 +1686,7 @@ If there is an error and no existing checkout return nil."
'package-build
`(:url ,quelpa-melpa-repo-url :files ("*"))
quelpa-melpa-dir)
(error "failed to checkout melpa git repo: `%s'" (error-message-string err)))))
(error "Failed to checkout melpa git repo: `%s'" (error-message-string err)))))
(defun quelpa-get-melpa-recipe (name)
"Read recipe with NAME for melpa git checkout.
@ -1667,7 +1725,7 @@ Return non-nil if quelpa has been initialized properly."
(ignore-errors (delete-directory quelpa-packages-dir t)))
(defun quelpa-arg-rcp (arg)
"Given recipe or package name, return an alist '(NAME . RCP).
"Given recipe or package name ARG, return an alist '(NAME . RCP).
If RCP cannot be found it will be set to nil"
(pcase arg
(`(,a . nil) (quelpa-get-melpa-recipe (car arg)))
@ -1696,9 +1754,8 @@ If t, `quelpa' tries building the stable version of a package."
(defun quelpa-package-install-file (file)
"Workaround problem with `package-install-file'.
`package-install-file' uses `insert-file-contents-literally'
which causes problems when the file inserted has crlf line
endings (Windows). So here we replace that with
`insert-file-contents' for non-tar files."
which causes problems when the FILE inserted has crlf line endings (Windows).
So here we replace that with `insert-file-contents' for non-tar files."
(if (eq system-type 'windows-nt)
(cl-letf* ((insert-file-contents-literally-orig
(symbol-function 'insert-file-contents-literally))
@ -1710,12 +1767,12 @@ endings (Windows). So here we replace that with
(package-install-file file))
(package-install-file file)))
(defun quelpa-package-install (arg)
(defun quelpa-package-install (arg &rest plist)
"Build and install package from ARG (a recipe or package name).
If the package has dependencies recursively call this function to
install them."
PLIST is a plist that may modify the build and/or fetch process.
If the package has dependencies recursively call this function to install them."
(let* ((rcp (quelpa-arg-rcp arg))
(file (and rcp (quelpa-build rcp))))
(file (when rcp (quelpa-build (append rcp plist)))))
(when file
(let* ((pkg-desc (quelpa-get-package-desc file))
(requires (package-desc-reqs pkg-desc)))
@ -1744,7 +1801,7 @@ install them."
;;;###autoload
(defun quelpa-expand-recipe (recipe-name)
"Expand a given recipe name into full recipe.
"Expand a given RECIPE-NAME into full recipe.
If called interactively, let the user choose a recipe name and
insert the result into the current buffer."
(interactive (list (quelpa-interactive-candidate)))
@ -1764,11 +1821,12 @@ ARGS are additional options for the quelpa recipe."
(quelpa (append quelpa-recipe args) :upgrade t)))
;;;###autoload
(defun quelpa-upgrade ()
(defun quelpa-upgrade-all (&optional force)
"Upgrade all packages found in `quelpa-cache'.
This provides an easy way to upgrade all the packages for which
the `quelpa' command has been run in the current Emacs session."
(interactive)
the `quelpa' command has been run in the current Emacs session.
With prefix FORCE, packages will all be upgraded discarding local changes."
(interactive "P")
(when (quelpa-setup-p)
(let ((quelpa-upgrade-p t))
(when quelpa-self-upgrade-p
@ -1777,9 +1835,34 @@ the `quelpa' command has been run in the current Emacs session."
(cl-remove-if-not #'package-installed-p quelpa-cache :key #'car))
(mapc (lambda (item)
(when (package-installed-p (car (quelpa-arg-rcp item)))
(quelpa item)))
(quelpa item :force force)))
quelpa-cache))))
;;;###autoload
(defun quelpa-upgrade (rcp &optional action)
"Upgrade a package found in `quelpa-cache' with recipe RCP.
Optionally, ACTION can be passed for non-interactive call with value of:
- `force' (or \\[universal-argument] \\[quelpa-upgrade]) for forced upgrade.
- `local' (or \\[universal-argument] \\[universal-argument] \\[quelpa-upgrade])
for upgrade using current working tree."
(interactive
(when (quelpa-setup-p)
(let* ((quelpa-melpa-recipe-stores (list quelpa-cache))
(name (quelpa-interactive-candidate))
(prefix (prefix-numeric-value current-prefix-arg)))
(list (assoc name quelpa-cache)
(cond ((eq prefix 4) 'force)
((eq prefix 16) 'local))))))
(when rcp
(let ((quelpa-upgrade-p t)
(current-prefix-arg nil)
(config (cond ((eq action 'force) `(:force t))
((eq action 'local) `(:use-current-ref t)))))
(setq quelpa-cache
(cl-remove-if-not #'package-installed-p quelpa-cache :key #'car))
(when (package-installed-p (car (quelpa-arg-rcp rcp)))
(apply #'quelpa rcp config)))))
;;;###autoload
(defun quelpa (arg &rest plist)
"Build and install a package with quelpa.
@ -1789,8 +1872,9 @@ If called interactively, `quelpa' will prompt for a MELPA package
to install.
When `quelpa' is called interactively with a prefix argument (e.g
C-u M-x quelpa) it will try to upgrade the given package even if
the global var `quelpa-upgrade-p' is set to nil."
\\[universal-argument] \\[quelpa]) it will try to upgrade the
given package even if the global var `quelpa-upgrade-p' is set to
nil."
(interactive (list (quelpa-interactive-candidate)))
(run-hooks 'quelpa-before-hook)
@ -1800,7 +1884,7 @@ the global var `quelpa-upgrade-p' is set to nil."
(cache-item (if (symbolp arg) (list arg) arg)))
(quelpa-parse-plist plist)
(quelpa-parse-stable cache-item)
(quelpa-package-install arg)
(apply #'quelpa-package-install arg plist)
(quelpa-update-cache cache-item)))
(quelpa-shutdown)
(run-hooks 'quelpa-after-hook))