Polish package management system

This commit is contained in:
Henrik Lissner 2017-02-19 06:59:55 -05:00
parent b8f5d549ea
commit c68ae247b5
2 changed files with 215 additions and 162 deletions

View file

@ -1,22 +1,15 @@
;;; packages.el
(provide 'doom-lib-packages)
(defvar doom-packages-last-refresh nil
"A timestamp indicating the last time `package-refresh-contents' was run.")
;;;###autoload
(defun doom-refresh-packages ()
"Refresh ELPA packages."
(doom-initialize)
(let ((refresh-cache (f-expand "last-pkg-refresh" doom-cache-dir)))
(when (and (not doom-packages-last-refresh)
(f-exists-p refresh-cache))
(setq doom-packages-last-refresh (read (f-read refresh-cache))))
(when (or (not doom-packages-last-refresh)
(> (nth 1 (time-since doom-packages-last-refresh)) 600))
(let ((last-refresh (persistent-soft-fetch 'last-pkg-refresh "emacs")))
(when (or (not last-refresh)
(> (nth 1 (time-since last-refresh)) 600))
(package-refresh-contents)
(setq doom-packages-last-refresh (current-time))
(f-write (pp-to-string doom-packages-last-refresh) 'utf-8 refresh-cache))))
(persistent-soft-store 'last-pkg-refresh (current-time) "emacs"))))
;;;###autoload
(defun doom-package-backend (name)
@ -36,19 +29,20 @@ quelpa or nil (if not installed)."
"Determine whether NAME (a symbol) is outdated or not. If outdated, returns a
list, whose car is NAME, and cdr the current version list and latest version
list of the package."
(doom-refresh-packages)
(-when-let (pkg (assq name package-alist))
(doom-initialize)
(when-let (pkg (assq name package-alist))
(let* ((old-version (package-desc-version (cadr pkg)))
(new-version
(pcase (doom-package-backend name)
('quelpa
(let ((recipe (assq name quelpa-cache))
(dir (f-expand (symbol-name name) quelpa-build-dir))
(dir (expand-file-name (symbol-name name) quelpa-build-dir))
(inhibit-message t))
(-if-let (ver (and (quelpa-setup-p) (quelpa-checkout recipe dir)))
(if-let (ver (and (quelpa-setup-p) (quelpa-checkout recipe dir)))
(version-to-list ver)
old-version)))
('elpa
(doom-refresh-packages)
(let ((desc (cadr (assq name package-archive-contents))))
(when (package-desc-p desc)
(package-desc-version desc)))))))
@ -63,15 +57,26 @@ Each element is a cons cell, whose car is the package symbol and whose cdr is
the quelpa recipe (if any).
BACKEND can be 'quelpa or 'elpa, and will instruct this function to return only
the packages relevant to that backend."
the packages relevant to that backend.
Warning: this function is expensive; it re-evaluates all of doom's config files.
Be careful not to use it in a loop."
(doom-initialize-packages t)
(unless (quelpa-setup-p)
(error "Could not initialize quelpa"))
(-non-nil
(--map (or (assq it doom-packages)
(list (car (assq it package-alist))))
(append doom-protected-packages
(mapcar 'car doom-packages)))))
(delete
nil
(mapcar (lambda (pkgsym)
(or (assq pkgsym doom-packages)
(list (car (assq pkgsym package-alist)))))
(append doom-protected-packages (mapcar 'car doom-packages)))))
;;;###autoload
(defun doom-get-dependencies-for (name)
"Return a list of packages that depend on the package named NAME."
(doom-initialize)
(when-let (desc (cadr (assq name package-alist)))
(mapcar 'package-desc-name (package--used-elsewhere-p desc nil t))))
;;;###autoload
(defun doom-get-outdated-packages ()
@ -79,8 +84,7 @@ the packages relevant to that backend."
containing (PACKAGE-SYMBOL OLD-VERSION-LIST NEW-VERSION-LIST).
Used by `doom/packages-update'."
(-non-nil (--map (doom-package-outdated-p (car it))
(doom-get-packages))))
(delq nil (mapcar 'doom-package-outdated-p (mapcar 'car (doom-get-packages)))))
;;;###autoload
(defun doom-get-orphaned-packages ()
@ -89,30 +93,45 @@ depended on.
Used by `doom/packages-autoremove'."
(doom-initialize-packages t)
(let ((package-selected-packages (append (mapcar 'car doom-packages) doom-protected-packages)))
(let ((package-selected-packages
(append (mapcar 'car doom-packages) doom-protected-packages)))
(package--removable-packages)))
;;;###autoload
(defun doom-get-missing-packages ()
"Return a list of packages that aren't installed, but need to be. Each element
is a list whose CAR is the package symbol, and whose CDR is a plist taken from
that package's `@package' declaration.
"Return a list of requested packages that aren't installed or built-in. Each
element is a list whose CAR is the package symbol, and whose CDR is a plist
taken from that package's `@package' declaration.
Used by `doom/packages-install'."
(--remove (assq (car it) package-alist) (doom-get-packages)))
(cl-remove-if (lambda (pkgsym)
(or (assq (car pkgsym) package-alist)
(and (not (plist-get (assq (car pkgsym) doom-packages) :pin))
(assq (car pkgsym) package--builtins))))
(doom-get-packages)))
;;;###autoload
(defun doom*package-delete (name)
(defun doom*package-delete (name &rest _)
"Update `quelpa-cache' upon a successful `package-delete'."
(when (and (not (package-installed-p name))
(quelpa-setup-p)
(assq name quelpa-cache))
(setq quelpa-cache (assq-delete-all name quelpa-cache))
(quelpa-save-cache)
(let ((path (f-expand (symbol-name name) quelpa-build-dir)))
(when (f-exists-p path)
(let ((path (expand-file-name (symbol-name name) quelpa-build-dir)))
(when (file-exists-p path)
(delete-directory path t)))))
;;; Private functions
(defsubst doom--version-list-str (vlist)
(concat (number-to-string (car vlist))
"."
(number-to-string (cadr vlist))))
(defsubst doom--sort-alpha (it other)
(string-lessp (symbol-name (car it))
(symbol-name (car other))))
;;
;; Main functions
@ -135,7 +154,7 @@ example; the package name can be omitted)."
(defun doom-update-package (name)
"Updates package NAME if it is out of date, using quelpa or package.el as
appropriate."
(doom-refresh-packages)
(doom-initialize)
(unless (package-installed-p name)
(error "%s isn't installed" name))
(when (doom-package-outdated-p name)
@ -157,13 +176,14 @@ appropriate."
(package-desc-version (cadr (assq name package-alist)))
(package-desc-version (cadr (assq name package-archive-contents))))))
(defun doom-delete-package (name)
(defun doom-delete-package (name &optional force-p)
"Uninstalls package NAME if it exists, and clears it from `quelpa-cache'."
(doom-initialize)
(unless (package-installed-p name)
(error "%s isn't installed" name))
(let ((desc (cadr (assq name package-alist))))
(package-delete desc))
(let ((desc (cadr (assq name package-alist)))
(inhibit-message t))
(package-delete desc force-p))
(not (package-installed-p name)))
@ -179,76 +199,79 @@ appropriate."
(cond ((not packages)
(message "No packages to install!"))
((not (y-or-n-p
(format "%s packages will be installed:\n\n%s\n\nProceed?"
(length packages)
(mapconcat (lambda (pkg)
(format "+ %s (%s)"
(car pkg)
(if (plist-get (cdr pkg) :recipe)
"QUELPA"
"ELPA")))
(--sort (string-lessp (symbol-name (car it))
(symbol-name (car other)))
packages)
"\n"))))
((not (or (getenv "YES")
(y-or-n-p
(format "%s packages will be installed:\n\n%s\n\nProceed?"
(length packages)
(mapconcat (lambda (pkg)
(format "+ %s (%s)"
(car pkg)
(if (plist-get (cdr pkg) :recipe)
"QUELPA"
"ELPA")))
(sort (cl-copy-list packages) 'doom--sort-alpha)
"\n")))))
(message "Aborted!"))
(t
(doom-message "Installing %s packages" (length packages))
(message "Installing %s packages" (length packages))
(dolist (pkg packages)
(condition-case ex
(doom-message "%s %s (%s)"
(cond ((package-installed-p (car pkg))
"Skipped (already installed)")
((doom-install-package (car pkg) (cdr pkg))
"Installed")
(t "Failed to install"))
(car pkg)
(cond ((cdr pkg) "QUELPA")
(t "ELPA")))
(progn
(message "%s %s (%s)"
(cond ((package-installed-p (car pkg))
"Skipped (already installed)")
((doom-install-package (car pkg) (cdr pkg))
"Installed")
(t "Failed to install"))
(car pkg)
(cond ((cdr pkg) "QUELPA")
(t "ELPA"))))
(error
(doom-message "Error (%s): %s" (car pkg) ex))))
(message "Error (%s): %s" (car pkg) ex))))
(doom-message "Finished!")))))
(message "Finished!")))))
;;;###autoload
(defun doom/packages-update ()
"Interactive command for updating packages."
(interactive)
(let ((packages (doom-get-outdated-packages)))
(let ((packages (cl-sort (doom-get-outdated-packages) 'doom--sort-alpha)))
(cond ((not packages)
(message "Everything is up-to-date"))
((not (y-or-n-p
(format "%s packages will be updated:\n\n%s\n\nProceed?"
(length packages)
(let ((-max-len (or (-max (--map (length (symbol-name (car it))) packages)) 10)))
(mapconcat
(lambda (pkg)
(format "+ %s %s -> %s"
(s-pad-right (+ -max-len 2) " " (symbol-name (car pkg)))
(s-pad-right 14 " " (doom--version-list-str (cadr pkg)))
(doom--version-list-str (cl-caddr pkg))))
(--sort (string-lessp (symbol-name (car it))
(symbol-name (car other)))
packages)
"\n")))))
((not (or (getenv "YES")
(y-or-n-p
(format "%s packages will be updated:\n\n%s\n\nProceed?"
(length packages)
(let ((max-len
(or (car (sort (mapcar (lambda (it) (length (symbol-name (car it)))) packages)
(lambda (it other) (> it other))))
10)))
(mapconcat
(lambda (pkg)
(format "+ %s %s -> %s"
(s-pad-right (+ max-len 2) " " (symbol-name (car pkg)))
(s-pad-right 14 " " (doom--version-list-str (cadr pkg)))
(doom--version-list-str (cl-caddr pkg))))
packages
"\n"))))))
(message "Aborted!"))
(t
(dolist (pkg packages)
(condition-case ex
(doom-message "%s %s"
(if (doom-update-package (car pkg))
"Updated"
"Failed to update")
(car pkg))
(progn
(message "%s %s"
(if (doom-update-package (car pkg))
"Updated"
"Failed to update")
(car pkg)))
(error
(doom-message "Error installing %s: %s" (car pkg) ex))))
(message "Error installing %s: %s" (car pkg) ex))))
(doom-message "Finished!")))))
(message "Finished!")))))
;;;###autoload
(defun doom/packages-autoremove ()
@ -258,31 +281,27 @@ appropriate."
(cond ((not packages)
(message "No unused packages to remove"))
((not (y-or-n-p
(format "%s packages will be deleted:\n\n%s\n\nProceed?"
(length packages)
(mapconcat (lambda (sym) (format "+ %s" (symbol-name sym)))
(-sort 'string-lessp packages)
"\n"))))
((not (or (getenv "YES")
(y-or-n-p
(format "%s packages will be deleted:\n\n%s\n\nProceed?"
(length packages)
(mapconcat (lambda (sym) (format "+ %s" (symbol-name sym)))
(sort (cl-copy-list packages) 'string-lessp)
"\n")))))
(message "Aborted!"))
(t
(dolist (pkg packages)
(condition-case ex
(doom-message "%s %s"
(if (doom-delete-package pkg)
(message "%s %s"
(if (doom-delete-package pkg t)
"Deleted"
"Failed to delete")
pkg)
(error
(doom-message "Error deleting %s: %s" pkg ex))))
(message "Error deleting %s: %s" pkg ex))))
(doom-message "Finished!")))))
(defun doom--version-list-str (vlist)
(concat (number-to-string (car vlist))
"."
(number-to-string (cadr vlist))))
(message "Finished!")))))
;;;###autoload
(defalias 'doom/install-package 'package-install)
@ -313,9 +332,9 @@ calls."
(let ((packages (doom-get-outdated-packages)))
(list
(if packages
(completing-read "Update package: " (--map (symbol-name (car it)) packages))
(completing-read "Update package: " (mapcar 'symbol-name (mapcar 'car packages)))
(user-error "All packages are up-to-date")))))
(-if-let (desc (doom-package-outdated-p (intern package)))
(if-let (desc (doom-package-outdated-p (intern package)))
(if (y-or-n-p (format "%s will be updated from %s to %s. Update?"
(car desc)
(doom--version-list-str (cadr desc))

View file

@ -1,5 +1,6 @@
;;; core-packages.el
;;
(defvar doom-start-time (current-time))
;; Emacs package management is opinionated. Unfortunately, so am I. So with the
;; help of `use-package', `quelpa' and package.el, DOOM Emacs manages my
;; plugins and internal module dependency chains.
@ -55,7 +56,7 @@ package's name as a symbol, and whose CDR is the plist supplied to its
`@package' declaration.")
(defvar doom-protected-packages
'(quelpa use-package dash f s)
'(quelpa use-package)
"A list of packages that must be installed (and will be auto-installed if
missing) and shouldn't be deleted.")
@ -83,8 +84,11 @@ packages exist.")
use-package-debug nil
use-package-verbose doom-debug-mode
;; Don't use MELPA, we'll use package.el for those
quelpa-checkout-melpa-p nil
quelpa-update-melpa-p nil
quelpa-melpa-recipe-stores nil
quelpa-self-upgrade-p nil
quelpa-dir (expand-file-name "quelpa" doom-packages-dir)
byte-compile-dynamic t
@ -160,20 +164,18 @@ even if they are."
('error (message "INIT-PACKAGES ERROR (%s): %s" file ex))))))
(when (or force-p (not doom-modules))
(setq doom-modules nil)
(funcall load-fn (f-expand "init.el" doom-emacs-dir))
(funcall load-fn (expand-file-name "init.el" doom-emacs-dir))
(when load-p
(mapc (lambda (file) (funcall load-fn file t))
(append (reverse (f-glob "core*.el" doom-core-dir))
(f-glob "autoload/*.el" doom-core-dir)
(--map (doom-module-path (car it) (cdr it) "config.el")
(doom--module-pairs))))))
(append (reverse (file-expand-wildcards (concat doom-core-dir "core*.el")))
(file-expand-wildcards (concat doom-core-dir "autoload/*.el"))
(doom--module-paths "config.el")))))
(when (or force-p (not doom-packages))
(setq doom-packages nil)
(funcall load-fn (f-expand "packages.el" doom-core-dir))
(funcall load-fn (expand-file-name "packages.el" doom-core-dir))
(mapc (lambda (file) (funcall load-fn file t))
(--map (doom-module-path (car it) (cdr it) "packages.el")
(doom--module-pairs))))))
(doom--module-paths "packages.el")))))
(defun doom-initialize-modules (modules)
"Adds MODULES to `doom-modules'. MODULES must be in mplist format.
@ -188,11 +190,16 @@ even if they are."
((not mode)
(error "No namespace specified on `@doom' for %s" m))
((eq m '*)
(let ((mode-str (substring (symbol-name mode) 1)))
(doom-initialize-modules
(cons mode
(--map (intern (f-base it))
(f-directories (f-expand mode-str doom-modules-dir)))))))
(doom-initialize-modules
(cons mode
(mapcar
(lambda (dir) (intern (file-name-nondirectory dir)))
(cl-remove-if-not
'file-directory-p
(directory-files (expand-file-name
(substring (symbol-name mode) 1)
doom-modules-dir)
t "^\\w"))))))
(t
(doom--enable-module mode m))))))
@ -205,8 +212,8 @@ even if they are."
(error "Expected a symbol, got %s" submodule))
(let ((module-name (substring (symbol-name module) 1))
(submodule-name (symbol-name submodule)))
(f-expand (concat module-name "/" submodule-name "/" file)
doom-modules-dir)))
(expand-file-name (concat module-name "/" submodule-name "/" file)
doom-modules-dir)))
(defun doom-module-loaded-p (module submodule)
"Returns t if MODULE->SUBMODULE is present in `doom-modules'."
@ -221,6 +228,16 @@ is sorted by order of insertion."
doom-modules)
pairs))
(defun doom--module-paths (&optional append-file)
"Returns a list of absolute file paths to modules, with APPEND-FILE added, if
the file exists."
(let (paths)
(dolist (pair (doom--module-pairs))
(let ((path (doom-module-path (car pair) (cdr pair) append-file)))
(when (file-exists-p path)
(push path paths))))
(reverse paths)))
(defun doom--enable-module (module submodule &optional force-p)
"Adds MODULE and SUBMODULE to `doom-modules', if it isn't already there (or if
FORCE-P is non-nil). MODULE is a keyword, SUBMODULE is a symbol. e.g. :lang
@ -230,6 +247,11 @@ Used by `@require' and `@depends-on'."
(unless (or force-p (doom-module-loaded-p module submodule))
(puthash (cons module submodule) t doom-modules)))
(defun doom--display-benchmark ()
(message "Loaded %s packages in %.03fs"
(- (length load-path) (length doom--base-load-path))
(float-time (time-subtract nil doom-start-time))))
;;
;; Macros
@ -241,10 +263,10 @@ Used by `@require' and `@depends-on'."
"DOOM Emacs bootstrap macro. List the modules to load. Benefits from
byte-compilation."
(doom-initialize-modules modules)
(unless noninteractive
`(let (file-name-handler-alist)
(setq doom-modules ',doom-modules)
`(let (file-name-handler-alist)
(setq doom-modules ',doom-modules)
(unless noninteractive
,@(mapcar (lambda (module) `(@require ,(car module) ,(cdr module) t))
(doom--module-pairs))
@ -254,35 +276,41 @@ byte-compilation."
(server-start)))
;; Benchmark
(format "Loaded %s packages in %s"
(- (length load-path) (length doom--base-load-path))
(emacs-init-time)))))
(add-hook 'after-init-hook 'doom--display-benchmark t))))
(defalias '@def-package 'use-package
"A `use-package' alias. It exists so DOOM configs adhere to the naming
conventions of DOOM emacs. Note that packages are deferred by default.")
(defmacro @def-package (name &rest plist)
"Defines and configures a package using `use-package'. Packages are deferred
by default. If the package isn't installed or loaded, `@def-package' is
ignored."
(when (or (featurep name)
(package-installed-p name))
`(use-package ,name ,@plist)))
(defmacro @load (filesym &optional path noerror)
"Loads a file relative to the current module (or PATH). FILESYM is a file path
as a symbol. PATH is a directory to prefix it with. If NOERROR is non-nil, don't
throw an error if the file doesn't exist.
Sets `__FILE__' and `__DIR__' on the loaded file."
(let ((path (or (and path (eval path)) (__DIR__))))
throw an error if the file doesn't exist."
(let ((path (or (and path
(cond ((symbolp path) (symbol-value path))
((stringp path) path)
((listp path) (eval path))))
(and load-file-name (file-name-directory load-file-name))
(and buffer-file-name (file-name-directory buffer-file-name))
(and (bound-and-true-p byte-compile-current-file)
(file-name-directory byte-compile-current-file)))))
(unless path
(error "Could not find %s" filesym))
(let ((file (f-expand (concat (symbol-name filesym) ".el") path)))
(if (f-exists-p file)
`(let ((__FILE__ ,file)
(__DIR__ ,path))
(load ,(f-no-ext file) ,noerror (not doom-debug-mode)))
(let ((file (expand-file-name (concat (symbol-name filesym) ".el") path)))
(if (file-exists-p file)
`(load ,(file-name-sans-extension file) ,noerror (not doom-debug-mode))
(unless noerror
(error "Could not @load file %s" file))))))
(defmacro @require (module submodule &optional reload-p)
"Like `require', but for doom modules. Will load a module's config.el file if
it hasn't already, and if it exists."
(unless noninteractive
(when (or (not noninteractive)
(bound-and-true-p byte-compile-current-file))
(let ((loaded-p (doom-module-loaded-p module submodule)))
(when (or reload-p (not loaded-p))
(unless loaded-p
@ -353,22 +381,28 @@ the commandline."
(doom-initialize-packages noninteractive)
(let ((generated-autoload-file doom-autoload-file)
(autoload-files
(append (-flatten (--map (let ((auto-dir (f-expand "autoload" it))
(auto-file (f-expand "autoload.el" it)))
(append (and (f-exists-p auto-file)
(list auto-file))
(and (f-directory-p auto-dir)
(f-glob "*.el" auto-dir))))
(--map (doom-module-path (car it) (cdr it))
(doom--module-pairs))))
(f-glob "autoload/*.el" doom-core-dir))))
(when (f-exists-p generated-autoload-file)
(f-delete generated-autoload-file)
(file-expand-wildcards
(expand-file-name "autoload/*.el" doom-core-dir))))
(dolist (path (doom--module-paths))
(let ((auto-dir (expand-file-name "autoload" path))
(auto-file (expand-file-name "autoload.el" path)))
(when (file-exists-p auto-file)
(push auto-file autoload-files))
(when (file-directory-p auto-dir)
(mapc (lambda (file)
;; Make evil.el autoload files a special case; don't load them
;; unless evil is enabled.
(unless (and (equal (file-name-nondirectory file) "evil.el")
(not (@featurep :feature evil)))
(push file autoload-files)))
(file-expand-wildcards (expand-file-name "*.el" auto-dir) t)))))
(when (file-exists-p generated-autoload-file)
(delete-file generated-autoload-file)
(message "Deleted old autoloads.el"))
(dolist (file autoload-files)
(dolist (file (reverse autoload-files))
(let ((inhibit-message t))
(update-file-autoloads file))
(message "Scanned %s" (f-relative file doom-emacs-dir)))
(message "Scanned %s" (file-relative-name file doom-emacs-dir)))
(condition-case ex
(with-current-buffer (get-file-buffer generated-autoload-file)
(save-buffer)
@ -387,23 +421,23 @@ There should be a measurable benefit from this, but it may take a while."
;; eval-when-compile and require blocks scattered all over.
(doom-initialize-packages t noninteractive)
(let ((targets
(append (list (f-expand "init.el" doom-emacs-dir)
(f-expand "core.el" doom-core-dir))
(f-glob "core-*.el" doom-core-dir)
(f-glob "autoload/*.el" doom-core-dir)
(unless simple-p
(-flatten
(--map (f--entries (doom-module-path (car it) (cdr it))
(and (f-ext-p it "el")
(let ((fname (f-filename it)))
(or (string= fname "config.el")
(s-prefix-p "+" fname t))))
t)
(doom--module-pairs))))))
(append (list (expand-file-name "init.el" doom-emacs-dir)
(expand-file-name "core.el" doom-core-dir))
(file-expand-wildcards (expand-file-name "core-*.el" doom-core-dir))
(file-expand-wildcards (expand-file-name "autoload/*.el" doom-core-dir))))
(n 0)
results)
(unless simple-p
(dolist (path (doom--module-paths))
(nconc targets
(cl-remove-if (lambda (file)
(let ((fname (file-name-nondirectory file)))
(or (string= fname ".")
(string= fname ".."))))
(reverse
(directory-files-recursively path "\\.el$"))))))
(dolist (file targets)
(push (cons (f-relative file doom-emacs-dir)
(push (cons (file-relative-name file doom-emacs-dir)
(and (byte-recompile-file file nil 0)
(setq n (1+ n))))
results))