Update quelpa.el to latest version
This commit is contained in:
Maximilian Wolff
parent
fcb79bf55b
commit
d10ca8d6d5
1 changed files with 145 additions and 61 deletions
|
|
@ -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))
|
||||
|
|
|
|||
Reference in a new issue