mirror of
https://github.com/dimitri/el-get.git
synced 2024-09-29 04:58:53 +08:00
ccca97f226
Since Emacs 27 the package cl is deprecated, the replacement is cl-lib, which is available since Emacs 24.3. This patch replaces cl by cl-lib and drops support for Emacs versions less than 24.3. Dropping older Emacsen is required, because cl-lib is a builtin starting from version 24.3 and doesn't need an extra package from ELPA. Testcases for past issues still contain cl. Most of them seem to be broken and need further investigation. This patch is tested with test/run-ert.sh, which outputs: Ran 10 tests, 10 results as expected, 0 unexpected (2021-01-30 13:24:54+0100, 0.672122 sec) 1 expected failures and manually by daily usage for a month now.
378 lines
16 KiB
EmacsLisp
378 lines
16 KiB
EmacsLisp
;;; el-get --- Manage the external elisp bits and pieces you depend upon
|
|
;;
|
|
;; Copyright (C) 2010-2011 Dimitri Fontaine
|
|
;;
|
|
;; Author: Dimitri Fontaine <dim@tapoueh.org>
|
|
;; URL: http://www.emacswiki.org/emacs/el-get
|
|
;; GIT: https://github.com/dimitri/el-get
|
|
;; Licence: WTFPL, grab your copy here: http://sam.zoy.org/wtfpl/
|
|
;;
|
|
;; This file is NOT part of GNU Emacs.
|
|
;;
|
|
;; Install
|
|
;; Please see the README.md file from the same distribution
|
|
|
|
;;
|
|
;; package status --- a plist saved on a file, using symbols
|
|
;;
|
|
;; it should be possible to use strings instead, but in my tests it failed
|
|
;; miserably.
|
|
;;
|
|
|
|
(require 'cl-lib)
|
|
(require 'pp)
|
|
(require 'el-get-core)
|
|
|
|
(declare-function el-get-install "el-get" (package))
|
|
(declare-function el-get-package-is-installed "el-get" (package))
|
|
(declare-function el-get-print-package "el-get-list-packages" (package-name status &optional desc))
|
|
|
|
(defun el-get-package-name (package-symbol)
|
|
"Returns a package name as a string."
|
|
(cond ((keywordp package-symbol)
|
|
(substring (symbol-name package-symbol) 1))
|
|
((symbolp package-symbol)
|
|
(symbol-name package-symbol))
|
|
((stringp package-symbol)
|
|
package-symbol)
|
|
(t (error "Unknown package: %s" package-symbol))))
|
|
|
|
(defun el-get-package-symbol (package)
|
|
"Returns a package name as a non-keyword symbol"
|
|
(cond ((keywordp package)
|
|
(intern (substring (symbol-name package) 1)))
|
|
((symbolp package)
|
|
package)
|
|
((stringp package) (intern package))
|
|
(t (error "Unknown package: %s" package))))
|
|
|
|
(defun el-get-package-keyword (package-name)
|
|
"Returns a package name as a keyword :package."
|
|
(if (keywordp package-name)
|
|
package-name
|
|
(intern (format ":%s" package-name))))
|
|
|
|
(defvar el-get-status-cache nil
|
|
"Cache used by `el-get-read-status-file'.")
|
|
|
|
(defvar el-get-package-menu-buffer) ; from el-get-list-packages.el
|
|
(defun el-get-save-package-status (package status &optional recipe)
|
|
"Save given package status"
|
|
(let* ((package (el-get-as-symbol package))
|
|
(recipe
|
|
(or recipe
|
|
(when (string= status "installed")
|
|
(el-get-package-def package))))
|
|
(package-status-alist
|
|
(assq-delete-all package (el-get-read-status-file)))
|
|
(new-package-status-alist
|
|
(sort
|
|
;; Do not save package information if status is removed.
|
|
(if (string= status "removed")
|
|
package-status-alist
|
|
(append package-status-alist
|
|
(list ; alist of (PACKAGE . PROPERTIES-LIST)
|
|
(cons package (list 'status status 'recipe recipe)))))
|
|
(lambda (p1 p2)
|
|
(string< (el-get-as-string (car p1))
|
|
(el-get-as-string (car p2)))))))
|
|
(cl-assert (listp recipe) nil
|
|
"Recipe must be a list")
|
|
(with-temp-file el-get-status-file
|
|
(insert (el-get-print-to-string new-package-status-alist 'pretty)))
|
|
;; Update cache
|
|
(setq el-get-status-cache new-package-status-alist)
|
|
;; Update package menu, if it exists
|
|
(save-excursion
|
|
(when (and (bound-and-true-p el-get-package-menu-buffer)
|
|
(buffer-live-p el-get-package-menu-buffer)
|
|
(set-buffer el-get-package-menu-buffer)
|
|
(eq major-mode 'el-get-package-menu-mode))
|
|
(goto-char (point-min))
|
|
(let ((inhibit-read-only t)
|
|
(name (el-get-package-name package)))
|
|
(when (re-search-forward
|
|
(format "^..%s[[:blank:]]+[^[:blank:]]+[[:blank:]]+"
|
|
(regexp-quote name)) nil t)
|
|
(delete-region (match-beginning 0) (match-end 0))
|
|
(el-get-print-package name status)))))
|
|
;; Return the new alist
|
|
new-package-status-alist))
|
|
|
|
(defun el-get-convert-from-old-status-format (old-status-list)
|
|
"Convert OLD-STATUS-LIST, a property list, to the new format"
|
|
;; first backup the old status just in case
|
|
(with-temp-file (format "%s.old" el-get-status-file)
|
|
(insert (el-get-print-to-string old-status-list)))
|
|
;; now convert to the new format, fetching recipes as we go
|
|
(cl-loop for (p s) on old-status-list by 'cddr
|
|
for psym = (el-get-package-symbol p)
|
|
when psym
|
|
collect
|
|
(cons psym
|
|
(list 'status s
|
|
'recipe (when (string= s "installed")
|
|
(condition-case nil
|
|
(el-get-package-def psym)
|
|
;; If the recipe is not available any more,
|
|
;; just provide a placeholder no-op recipe.
|
|
(error `(:name ,psym :type builtin))))))))
|
|
|
|
(defun el-get-clear-status-cache ()
|
|
"Clear in-memory cache for status file."
|
|
(setq el-get-status-cache nil))
|
|
|
|
(defun el-get-read-status-file ()
|
|
"read `el-get-status-file' and return an alist of plist like:
|
|
(PACKAGE . (status \"status\" recipe (:name ...)))"
|
|
(or el-get-status-cache
|
|
(setq el-get-status-cache (el-get-read-status-file-force))))
|
|
|
|
(defun el-get-read-status-file-force ()
|
|
"Forcefully load status file."
|
|
(let* ((ps
|
|
(if (file-exists-p el-get-status-file)
|
|
(car (with-temp-buffer
|
|
(insert-file-contents-literally el-get-status-file)
|
|
(read-from-string (buffer-string))))
|
|
;; If it doesn't exist, make sure the directory is there
|
|
;; so we can create it.
|
|
(make-directory el-get-dir t)))
|
|
(p-s
|
|
(cond
|
|
((null ps) ;; nothing installed, we should install el-get
|
|
(list (list 'el-get 'status "required")))
|
|
;; ps is an alist, no conversion needed
|
|
((consp (car ps)) ps)
|
|
;; looks like we might have an old format status list
|
|
(t (el-get-convert-from-old-status-format ps)))))
|
|
;; double check some status "conditions"
|
|
;;
|
|
;; a package with status "installed" and a missing directory is
|
|
;; automatically reset to "required" so that a proper install happens.
|
|
(cl-loop for (p . prop) in p-s
|
|
if (and (string= (plist-get prop 'status) "installed")
|
|
(not (file-directory-p (el-get-package-directory p))))
|
|
collect (cons p (plist-put prop 'status "required"))
|
|
else
|
|
collect (cons p prop))))
|
|
|
|
(defun el-get-package-status-alist ()
|
|
"return an alist of (PACKAGE . STATUS)"
|
|
(cl-loop for (p . prop) in (el-get-read-status-file)
|
|
collect (cons p (plist-get prop 'status))))
|
|
|
|
(defun el-get-package-status-recipes ()
|
|
"return the list of recipes stored in the status file"
|
|
(cl-loop for (p . prop) in (el-get-read-status-file)
|
|
when (string= (plist-get prop 'status) "installed")
|
|
collect (plist-get prop 'recipe)))
|
|
|
|
(defun el-get-read-package-status (package)
|
|
"return current status for PACKAGE"
|
|
(plist-get (cdr (assq (el-get-as-symbol package) (el-get-read-status-file)))
|
|
'status))
|
|
|
|
(define-obsolete-function-alias 'el-get-package-status 'el-get-read-package-status "4.1")
|
|
|
|
(defun el-get-read-package-status-recipe (package)
|
|
"return current status recipe for PACKAGE"
|
|
(plist-get (cdr (assq (el-get-as-symbol package) (el-get-read-status-file)))
|
|
'recipe))
|
|
|
|
(defun el-get-filter-package-alist-with-status (package-status-alist &rest statuses)
|
|
"Return package names that are currently in given status"
|
|
(cl-loop for (p . prop) in package-status-alist
|
|
for s = (plist-get prop 'status)
|
|
when (member s statuses)
|
|
collect (el-get-as-string p)))
|
|
|
|
(defun el-get-list-package-names-with-status (&rest statuses)
|
|
"Return package names that are currently in given status"
|
|
(apply #'el-get-filter-package-alist-with-status
|
|
(el-get-read-status-file)
|
|
statuses))
|
|
|
|
(defun el-get-read-package-with-status (action &rest statuses)
|
|
"Read a package name in given status"
|
|
(completing-read (format "%s package: " action)
|
|
(apply 'el-get-list-package-names-with-status statuses)))
|
|
|
|
(defun el-get-count-package-with-status (&rest statuses)
|
|
"Return how many packages are currently in given status"
|
|
(length (apply #'el-get-list-package-names-with-status statuses)))
|
|
|
|
(defun el-get-count-packages-with-status (packages &rest statuses)
|
|
"Return how many packages are currently in given status in PACKAGES"
|
|
(length (cl-intersection
|
|
(mapcar #'el-get-as-symbol (apply #'el-get-list-package-names-with-status statuses))
|
|
(mapcar #'el-get-as-symbol packages))))
|
|
|
|
(defun el-get-extra-packages (&rest packages)
|
|
"Return installed or required packages that are not in given package list"
|
|
(let ((packages
|
|
;; &rest could contain both symbols and lists
|
|
(cl-loop for p in packages
|
|
when (listp p) append (mapcar 'el-get-as-symbol p)
|
|
else collect (el-get-as-symbol p))))
|
|
(when packages
|
|
(cl-loop for (p . prop) in (el-get-read-status-file)
|
|
for s = (plist-get prop 'status)
|
|
for x = (el-get-package-symbol p)
|
|
unless (member x packages)
|
|
unless (equal s "removed")
|
|
collect (list x s)))))
|
|
|
|
(defmacro el-get-with-status-sources (_ &rest body)
|
|
"Evaluate BODY with `el-get-sources' according to the status file."
|
|
(declare (debug t) (indent 1))
|
|
`(let ((el-get-sources (el-get-package-status-recipes)))
|
|
(progn ,@body)))
|
|
|
|
|
|
(defconst el-get-status-init-whitelist
|
|
'(:load-path
|
|
:info
|
|
:load
|
|
:features
|
|
:library
|
|
:prepare
|
|
:before
|
|
:after
|
|
:post-init
|
|
:lazy
|
|
:website
|
|
:description)
|
|
"Properties that can be updated with only `el-get-init'.
|
|
|
|
If any of these properties change on the recipe for an installed
|
|
package, the changes may be merged into the cached version of
|
|
that recipe in the el-get status file.")
|
|
|
|
(defconst el-get-status-update-whitelist
|
|
`(:depends
|
|
:build
|
|
;; :build/* ; special cased below
|
|
:compile
|
|
:checksum
|
|
:checkout
|
|
:options
|
|
,@el-get-status-init-whitelist)
|
|
"Properties than can be updated by `el-get-update'.")
|
|
|
|
(defun el-get-classify-new-properties (source newprops)
|
|
"Determine the operations required to update SOURCE with NEWPROPS.
|
|
|
|
Partition the properties of NEWPROPS whose value is different
|
|
from SOURCE into 3 sublists, (INIT UPDATE REINSTALL), according
|
|
to the operation required."
|
|
(cl-loop with init and update and reinstall
|
|
with type = (let ((old-type (el-get-package-method source))
|
|
(new-type (el-get-package-method newprops)))
|
|
(if (eq old-type new-type) old-type nil))
|
|
for (k v) on newprops by 'cddr
|
|
if (equal v (plist-get source k)) do (ignore) ; Ignore non-changes.
|
|
else if
|
|
(or (memq k el-get-status-init-whitelist)
|
|
(if (eq k :builtin) ; `:builtin' safe if not crossing versions.
|
|
(eq (version<= emacs-version (el-get-as-string v))
|
|
(version<= emacs-version (el-get-as-string
|
|
(plist-get source k))))))
|
|
do (setq init (plist-put init k v))
|
|
else if (or (memq k el-get-status-update-whitelist)
|
|
;; All `:build/*' props are update safe, like `:build'.
|
|
(string-prefix-p ":build/" (symbol-name k))
|
|
(if (eq k :url) ; `:http*' methods can handle `:url' changes.
|
|
(memq type '(http http-tar http-zip
|
|
github-tar github-zip
|
|
builtin))))
|
|
do (setq update (plist-put update k v))
|
|
else do (setq reinstall (plist-put reinstall k v))
|
|
finally return (list init update reinstall)))
|
|
|
|
(defun el-get-diagnosis-properties (old-source new-source)
|
|
"Diagnosis difference between OLD-SOURCE and NEW-SOURCE.
|
|
|
|
Return a list (REQUIRED-OPS ADDED REMOVED). REQUIRED-OPS is list
|
|
of one or more of `init', `update', or `reinstall' when
|
|
OLD-SOURCE and NEW-SOURCE are different (nil otherwise). It
|
|
indicates which operations can perform the change. ADDED and
|
|
REMOVED are added and removed properties, respectively."
|
|
(let* ((added (el-get-classify-new-properties old-source new-source))
|
|
(removed (el-get-classify-new-properties new-source old-source))
|
|
(min-op (cond ((or (nth 2 added) (nth 2 removed)) 2)
|
|
((or (nth 1 added) (nth 1 removed)) 1)
|
|
((or (nth 0 added) (nth 0 removed)) 0))))
|
|
(list (and min-op (nthcdr min-op '(init update reinstall)))
|
|
(apply #'append (nthcdr (or min-op 0) added))
|
|
(apply #'append (nthcdr (or min-op 0) removed)))))
|
|
|
|
(defun el-get-package-or-source (package-or-source)
|
|
"Given either a package name or a full source entry, return a
|
|
full source entry."
|
|
(if (listp package-or-source)
|
|
(or package-or-source
|
|
(error "package-or-source cannot be nil"))
|
|
(el-get-package-def package-or-source)))
|
|
|
|
(defun el-get-read-cached-recipe (package source)
|
|
"Read the cached recipe for given PACKAGE: the one we have in the status file.
|
|
|
|
If given PACKAGE isn't registered in the status file, and if
|
|
it's a builtin package, then install it."
|
|
(or (el-get-read-package-status-recipe package)
|
|
(if (eq 'builtin (el-get-package-method source))
|
|
(let ((el-get-default-process-sync t))
|
|
(el-get-install package))
|
|
;; it's not builtin, it's not installed.
|
|
(error "Package %s is nowhere to be found in el-get status file."
|
|
package))))
|
|
|
|
(defun el-get-merge-properties-into-status (package-or-source
|
|
operation
|
|
&rest keys)
|
|
"Merge updatable properties for package into package status alist (or status file).
|
|
|
|
The first argument is either a package source or a package name,
|
|
in which case the source will be read using
|
|
`el-get-package-def'. The named package must already be
|
|
installed.
|
|
|
|
If the new source differs only in whitelisted properties (see
|
|
`el-get-status-recipe-updatable-properties'), then the updated
|
|
values for those properties will be written to the status
|
|
file.
|
|
|
|
If any non-whitelisted properties differ from the cached values,
|
|
then an error is raise. With optional keyword argument `:noerror
|
|
t', this error is suppressed (but nothing is updated).
|
|
|
|
\(fn PACKAGE-OR-SOURCE &key NOERROR)"
|
|
(interactive
|
|
(list (el-get-read-package-with-status "Update cached recipe" "installed")
|
|
'init
|
|
:noerror current-prefix-arg))
|
|
(let* ((noerror (cadr (memq :noerror keys)))
|
|
(source (el-get-package-or-source package-or-source))
|
|
(package (el-get-as-symbol (el-get-source-name source)))
|
|
(cached-recipe
|
|
(el-get-read-cached-recipe package source)))
|
|
(unless (el-get-package-is-installed package)
|
|
(error "Package %s is not installed. Cannot update recipe." package))
|
|
(cl-destructuring-bind (required-ops added removed)
|
|
(el-get-diagnosis-properties cached-recipe source)
|
|
(if (and required-ops (not (memq operation required-ops)))
|
|
;; Emit a verbose message if `noerror' is t (but still quit
|
|
;; the function).
|
|
(funcall (if noerror 'el-get-verbose-message 'error)
|
|
(concat "Must %s `%s' to modify its cached recipe\n"
|
|
" adding: %s"
|
|
" removing: %s")
|
|
(mapconcat #'symbol-name required-ops " or ") package
|
|
(if added (pp-to-string added) "()\n")
|
|
(if removed (pp-to-string removed) "()\n"))
|
|
(when required-ops
|
|
(el-get-save-package-status package "installed" source))))))
|
|
|
|
(provide 'el-get-status)
|