mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-01 12:17:25 -05:00
1350 lines
62 KiB
EmacsLisp
1350 lines
62 KiB
EmacsLisp
;;; lisp/lib/packages.el -*- lexical-binding: t; -*-
|
|
;;; Commentary:
|
|
;;
|
|
;; Emacs package management is opinionated, and so is Doom. Doom uses `straight'
|
|
;; to create a declarative, lazy-loaded, and (nominally) reproducible package
|
|
;; management system. We use `straight' over `package' because the latter is
|
|
;; tempermental. ELPA sources suffer downtime occasionally and often fail to
|
|
;; build packages when GNU Tar is unavailable (e.g. MacOS users start with BSD
|
|
;; tar). Known gnutls errors plague the current stable release of Emacs (26.x)
|
|
;; which bork TLS handshakes with ELPA repos (mainly gnu.elpa.org). See
|
|
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3434.
|
|
;;
|
|
;; What's worse, you can only get the latest version of packages through ELPA.
|
|
;; In an ecosystem that is constantly changing, this is more frustrating than
|
|
;; convenient. Straight (and Doom) can do rolling release, but it is opt-in.
|
|
;;
|
|
;; Interacting with this package management system is done through Doom's
|
|
;; bin/doom script. Find out more about it by running 'doom help' (I highly
|
|
;; recommend you add the script to your PATH). Here are some highlights:
|
|
;;
|
|
;; - `doom install`: a wizard that guides you through setting up Doom and your
|
|
;; private config for the first time.
|
|
;; - `doom sync`: your go-to command for making sure Doom is in optimal
|
|
;; condition. It ensures all unneeded packages are removed, all needed ones
|
|
;; are installed, and all metadata associated with them is generated.
|
|
;; - `doom upgrade`: upgrades Doom Emacs and your packages to the latest
|
|
;; versions. There's also 'bin/doom sync -u' for updating only your packages.
|
|
;;
|
|
;; How this works is: the system reads packages.el files located in each
|
|
;; activated module, your private config (`doom-user-dir'), and one in
|
|
;; `doom-core-dir'. These contain `package!' declarations that tell DOOM what
|
|
;; packages to install and where from.
|
|
;;
|
|
;; All that said, you can still use package.el's commands, but 'doom sync' will
|
|
;; purge ELPA packages.
|
|
;;
|
|
;;; Code:
|
|
|
|
(require 'comp nil t)
|
|
(require 'doom-straight)
|
|
(doom-require 'doom-lib 'modules)
|
|
|
|
|
|
;;
|
|
;;; Variables
|
|
|
|
;; DEPRECATED: Will be stored in the local profile in v3.0
|
|
(defvar doom-packages ()
|
|
"A list of enabled packages. Each element is a sublist, whose CAR is the
|
|
package's name as a symbol, and whose CDR is the plist supplied to its
|
|
`package!' declaration. Set by `doom-initialize-packages'.")
|
|
|
|
;; DEPRECATED: Will be stored in the local profile in v3.0
|
|
(defvar doom-disabled-packages ()
|
|
"A list of packages that should be ignored by `use-package!' and `after!'.")
|
|
|
|
|
|
;;
|
|
;;; Package management API
|
|
|
|
(defun doom--ensure-straight (recipe pin)
|
|
(with-environment-variables
|
|
(("GIT_CONFIG" nil)
|
|
("GIT_CONFIG_NOSYSTEM" "1")
|
|
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
|
|
"/dev/null")))
|
|
(let ((repo-dir (doom-path straight-base-dir "straight/repos/straight.el"))
|
|
(repo-url (concat "http" (if gnutls-verify-error "s")
|
|
"://github.com/"
|
|
(or (plist-get recipe :repo) "radian-software/straight.el")))
|
|
(branch (or (plist-get recipe :branch) straight-repository-branch))
|
|
(call (if init-file-debug
|
|
(lambda (&rest args)
|
|
(print! "%s" (cdr (apply #'doom-call-process args))))
|
|
(lambda (&rest args)
|
|
(apply #'doom-call-process args)))))
|
|
(unless (file-directory-p repo-dir)
|
|
(save-match-data
|
|
(unless (executable-find "git")
|
|
(user-error "Git isn't present on your system. Cannot proceed."))
|
|
(let* ((version (cdr (doom-call-process "git" "version")))
|
|
(version
|
|
(and (string-match "\\_<[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)\\_>" version)
|
|
(match-string 0 version))))
|
|
(if version
|
|
(when (version< version "2.23")
|
|
(user-error "Git %s detected! Doom requires git 2.23 or newer!"
|
|
version)))))
|
|
(print! (start "Installing straight..."))
|
|
(print-group!
|
|
(cl-destructuring-bind (depth . options)
|
|
(ensure-list straight-vc-git-default-clone-depth)
|
|
(let ((branch-switch (if (memq 'single-branch options)
|
|
"--single-branch"
|
|
"--no-single-branch")))
|
|
(cond
|
|
((eq 'full depth)
|
|
(funcall call "git" "clone" "--origin" "origin"
|
|
branch-switch repo-url repo-dir))
|
|
((integerp depth)
|
|
(if (null pin)
|
|
(progn
|
|
(when (file-directory-p repo-dir)
|
|
(delete-directory repo-dir 'recursive))
|
|
(funcall call "git" "clone" "--origin" "origin" repo-url
|
|
"--no-checkout" repo-dir
|
|
"--depth" (number-to-string depth)
|
|
branch-switch
|
|
"--no-tags"
|
|
"--branch" straight-repository-branch))
|
|
(make-directory repo-dir 'recursive)
|
|
(let ((default-directory repo-dir))
|
|
(funcall call "git" "init")
|
|
(funcall call "git" "branch" "-m" straight-repository-branch)
|
|
(funcall call "git" "remote" "add" "origin" repo-url
|
|
"--master" straight-repository-branch)
|
|
(funcall call "git" "fetch" "origin" pin
|
|
"--depth" (number-to-string depth)
|
|
"--no-tags")
|
|
(funcall call "git" "reset" "--hard" pin)))))))))
|
|
(require 'straight (concat repo-dir "/straight.el"))
|
|
(doom-log "Initializing recipes")
|
|
(mapc #'straight-use-recipes
|
|
'((org-elpa :local-repo nil)
|
|
(melpa :type git :host github
|
|
:repo "melpa/melpa"
|
|
:build nil)
|
|
(nongnu-elpa :type git :host github
|
|
:repo "emacsmirror/nongnu_elpa"
|
|
:local-repo "nongnu-elpa"
|
|
:build nil)
|
|
(gnu-elpa-mirror :type git :host github
|
|
:repo "emacs-straight/gnu-elpa-mirror"
|
|
:build nil)
|
|
(el-get :type git :host github
|
|
:repo "dimitri/el-get"
|
|
:build nil)
|
|
(emacsmirror-mirror :type git :host github
|
|
:repo "emacs-straight/emacsmirror-mirror"
|
|
:build nil))))))
|
|
|
|
(defun doom--ensure-core-packages (packages)
|
|
(doom-log "Installing core packages")
|
|
(dolist (package packages)
|
|
(let* ((name (car package))
|
|
(repo (symbol-name name)))
|
|
(when-let (recipe (plist-get (cdr package) :recipe))
|
|
(straight-override-recipe (cons name recipe))
|
|
(when-let (local-repo (plist-get recipe :local-repo))
|
|
(setq repo local-repo)))
|
|
(print-group!
|
|
;; Only clone the package, don't build them. Straight hasn't been fully
|
|
;; configured by this point.
|
|
(straight-use-package name nil t))
|
|
;; In case the package hasn't been built yet.
|
|
(or (member (directory-file-name (straight--build-dir (symbol-name name)))
|
|
load-path)
|
|
(add-to-list 'load-path (directory-file-name (straight--repos-dir repo)))))))
|
|
|
|
;;;###autoload
|
|
(defun doom-initialize-core-packages (&optional force-p)
|
|
"Ensure `straight' is installed and was compiled with this version of Emacs."
|
|
(when (or force-p (null (bound-and-true-p straight-recipe-repositories)))
|
|
(doom-log "Initializing straight")
|
|
(let ((packages (doom-package-list '((:doom)))))
|
|
(cl-destructuring-bind (&key recipe pin &allow-other-keys)
|
|
(alist-get 'straight packages)
|
|
(doom--ensure-straight recipe pin))
|
|
(doom--ensure-core-packages
|
|
(seq-filter (fn! (eq (plist-get (cdr %) :type) 'core))
|
|
packages)))))
|
|
|
|
;;;###autoload
|
|
(defun doom-initialize-packages (&optional force-p)
|
|
"Process all packages, essential and otherwise, if they haven't already been.
|
|
|
|
If FORCE-P is non-nil, do it anyway.
|
|
|
|
This ensures `doom-packages' is populated and `straight' recipes are properly
|
|
processed."
|
|
(doom-initialize-core-packages force-p)
|
|
(when (or force-p (not (bound-and-true-p package--initialized)))
|
|
(doom-log "Initializing package.el")
|
|
(require 'package)
|
|
(package-initialize)
|
|
(unless package--initialized
|
|
(error "Failed to initialize package.el")))
|
|
(when (or force-p (null doom-packages))
|
|
(doom-log "Initializing straight.el")
|
|
(setq doom-disabled-packages nil
|
|
doom-packages (doom-package-list))
|
|
(let (packages)
|
|
(dolist (package doom-packages)
|
|
(cl-destructuring-bind
|
|
(name &key recipe disable ignore &allow-other-keys) package
|
|
(if ignore
|
|
(straight-override-recipe (cons name '(:type built-in)))
|
|
(if disable
|
|
(cl-pushnew name doom-disabled-packages)
|
|
(when recipe
|
|
(straight-override-recipe (cons name recipe)))
|
|
(cl-callf append packages (cons name (straight--get-dependencies name)))))))
|
|
(dolist (package (cl-delete-duplicates packages :test #'equal))
|
|
(straight-register-package package)
|
|
(let ((name (symbol-name package)))
|
|
(add-to-list 'load-path (directory-file-name (straight--build-dir name)))
|
|
(straight--load-package-autoloads name))))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-get (package &optional prop nil-value)
|
|
"Returns PACKAGE's `package!' recipe from `doom-packages'."
|
|
(let ((plist (cdr (assq package doom-packages))))
|
|
(if prop
|
|
(if (plist-member plist prop)
|
|
(plist-get plist prop)
|
|
nil-value)
|
|
plist)))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-set (package prop value)
|
|
"Set PROPERTY in PACKAGE's recipe to VALUE."
|
|
(setf (alist-get package doom-packages)
|
|
(plist-put (alist-get package doom-packages)
|
|
prop value)))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-recipe (package &optional prop nil-value)
|
|
"Returns the `straight' recipe PACKAGE was registered with."
|
|
(let* ((recipe (straight-recipes-retrieve package))
|
|
(plist (doom-plist-merge
|
|
(plist-get (alist-get package doom-packages) :recipe)
|
|
(cdr (if (memq (car recipe) '(quote \`))
|
|
(eval recipe t)
|
|
recipe)))))
|
|
(if prop
|
|
(if (plist-member plist prop)
|
|
(plist-get plist prop)
|
|
nil-value)
|
|
plist)))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-recipe-repo (package)
|
|
"Resolve and return PACKAGE's (symbol) local-repo property."
|
|
(if-let* ((recipe (copy-sequence (doom-package-recipe package)))
|
|
(recipe (if (and (not (plist-member recipe :type))
|
|
(memq (plist-get recipe :host) '(github gitlab bitbucket)))
|
|
(plist-put recipe :type 'git)
|
|
recipe))
|
|
(repo (if-let* ((local-repo (plist-get recipe :local-repo)))
|
|
(directory-file-name local-repo)
|
|
(ignore-errors (straight-vc-local-repo-name recipe)))))
|
|
repo
|
|
(symbol-name package)))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-build-recipe (package &optional prop nil-value)
|
|
"Returns the `straight' recipe PACKAGE was installed with."
|
|
(let ((plist (nth 2 (gethash (symbol-name package) straight--build-cache))))
|
|
(if prop
|
|
(if (plist-member plist prop)
|
|
(plist-get plist prop)
|
|
nil-value)
|
|
plist)))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-dependencies (package &optional recursive noerror)
|
|
"Return a list of dependencies for a package.
|
|
|
|
If RECURSIVE is `tree', return a tree of dependencies.
|
|
If RECURSIVE is nil, only return PACKAGE's immediate dependencies.
|
|
If NOERROR, return nil in case of error."
|
|
(cl-check-type package symbol)
|
|
(let ((deps (straight-dependencies (symbol-name package))))
|
|
(pcase recursive
|
|
(`tree deps)
|
|
(`t (flatten-list deps))
|
|
(`nil (cl-remove-if #'listp deps)))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-depending-on (package &optional noerror)
|
|
"Return a list of packages that depend on PACKAGE.
|
|
|
|
If PACKAGE (a symbol) isn't installed, throw an error, unless NOERROR is
|
|
non-nil."
|
|
(cl-check-type package symbol)
|
|
;; can't get dependencies for built-in packages
|
|
(unless (or (doom-package-build-recipe package)
|
|
noerror)
|
|
(error "Couldn't find %s, is it installed?" package))
|
|
(straight-dependents (symbol-name package)))
|
|
|
|
;;; Predicate functions
|
|
;;;###autoload
|
|
(defun doom-package-built-in-p (package)
|
|
"Return non-nil if PACKAGE (a symbol) is built-in."
|
|
(eq (doom-package-build-recipe package :type)
|
|
'built-in))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-installed-p (package)
|
|
"Return non-nil if PACKAGE (a symbol) is installed."
|
|
(file-directory-p (straight--build-dir (symbol-name package))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-is-type-p (package type)
|
|
"TODO"
|
|
(memq type (ensure-list (doom-package-get package :type))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-in-module-p (package category &optional module)
|
|
"Return non-nil if PACKAGE was installed by the user's private config."
|
|
(when-let (modules (doom-package-get package :modules))
|
|
(or (and (not module) (assq :user modules))
|
|
(member (cons category module) modules))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-backend (package)
|
|
"Return 'straight, 'builtin, 'elpa or 'other, depending on how PACKAGE is
|
|
installed."
|
|
(cond ((gethash (symbol-name package) straight--build-cache)
|
|
'straight)
|
|
((or (doom-package-built-in-p package)
|
|
(assq package package--builtins))
|
|
'builtin)
|
|
((assq package package-alist)
|
|
'elpa)
|
|
((locate-library (symbol-name package))
|
|
'other)))
|
|
|
|
|
|
;;; Package getters
|
|
(defun doom-packages--read (file &optional noeval noerror)
|
|
(condition-case-unless-debug e
|
|
(with-temp-buffer ; prevent buffer-local state from propagating
|
|
(if (not noeval)
|
|
(load file noerror 'nomessage 'nosuffix)
|
|
(when (file-exists-p file)
|
|
(insert-file-contents file)
|
|
(with-syntax-table emacs-lisp-mode-syntax-table
|
|
;; Scrape `package!' blocks from FILE for a comprehensive listing of
|
|
;; packages used by this module.
|
|
(while (search-forward "(package!" nil t)
|
|
(let ((ppss (save-excursion (syntax-ppss))))
|
|
;; Don't collect packages in comments or strings
|
|
(unless (or (nth 3 ppss)
|
|
(nth 4 ppss))
|
|
(goto-char (match-beginning 0))
|
|
(cl-destructuring-bind (_ name . plist)
|
|
(read (current-buffer))
|
|
(push (cons
|
|
name (plist-put
|
|
plist :modules
|
|
(list (doom-module-context-key doom-module-context))))
|
|
doom-packages)))))))))
|
|
(user-error
|
|
(user-error (error-message-string e)))
|
|
(error
|
|
(signal 'doom-package-error
|
|
(list (doom-module-context-key doom-module-context)
|
|
file e)))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-list (&optional module-list)
|
|
"Retrieve a list of explicitly declared packages from MODULE-LIST.
|
|
|
|
If MODULE-LIST is omitted, read enabled module list in configdepth order (see
|
|
`doom-module-set'). Otherwise, MODULE-LIST may be any symbol (or t) to mean read
|
|
all modules in `doom-modules-dir', including :doom and :user. MODULE-LIST may
|
|
also be a list of module keys."
|
|
(let ((module-list (cond ((null module-list) (doom-module-list))
|
|
((symbolp module-list) (doom-module-list 'all))
|
|
(module-list)))
|
|
(packages-file doom-module-packages-file)
|
|
doom-disabled-packages
|
|
doom-packages)
|
|
(letf! (defun read-packages (key)
|
|
(with-doom-module key
|
|
(when-let (file (doom-module-locate-path
|
|
key doom-module-packages-file))
|
|
(doom-packages--read file nil 'noerror))))
|
|
(with-doom-context 'package
|
|
(let ((user? (assq :user module-list)))
|
|
(when user?
|
|
;; We load the private packages file twice to populate
|
|
;; `doom-disabled-packages' disabled packages are seen ASAP...
|
|
(let (doom-packages)
|
|
(read-packages (cons :user nil))))
|
|
(mapc #'read-packages module-list)
|
|
;; ...Then again to ensure privately overriden packages are properly
|
|
;; overwritten.
|
|
(if user? (read-packages (cons :user nil)))
|
|
(nreverse doom-packages))))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-pinned-alist ()
|
|
"Return an alist mapping package names (strings) to pinned commits (strings)."
|
|
(let (alist)
|
|
(dolist (package doom-packages alist)
|
|
(cl-destructuring-bind (name &key disable ignore pin unpin &allow-other-keys)
|
|
package
|
|
(when (and (not ignore)
|
|
(not disable)
|
|
(or pin unpin))
|
|
(setf (alist-get (file-name-nondirectory (doom-package-recipe-repo name))
|
|
alist nil 'remove #'equal)
|
|
(unless unpin pin)))))))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-recipe-alist ()
|
|
"Return straight recipes for non-builtin packages with a local-repo."
|
|
(let (recipes)
|
|
(dolist (recipe (hash-table-values straight--recipe-cache))
|
|
(cl-destructuring-bind (&key local-repo type &allow-other-keys)
|
|
recipe
|
|
(unless (or (null local-repo)
|
|
(eq type 'built-in))
|
|
(push recipe recipes))))
|
|
(nreverse recipes)))
|
|
|
|
;;;###autoload
|
|
(defun doom-package-homepage (package)
|
|
"return the url to package's homepage (usually a repo)."
|
|
(doom-initialize-packages)
|
|
(or (get package 'homepage)
|
|
(put package 'homepage
|
|
(cond ((when-let (location (locate-library (symbol-name package)))
|
|
(with-temp-buffer
|
|
(if (string-match-p "\\.gz$" location)
|
|
(jka-compr-insert-file-contents location)
|
|
(insert-file-contents (concat (file-name-sans-extension location) ".el")
|
|
nil 0 4096))
|
|
(let ((case-fold-search t))
|
|
(when (re-search-forward " \\(?:url\\|homepage\\|website\\): \\(http[^\n]+\\)\n" nil t)
|
|
(match-string-no-properties 1))))))
|
|
((when-let ((recipe (straight-recipes-retrieve package)))
|
|
(straight--with-plist (straight--convert-recipe recipe)
|
|
(host repo)
|
|
(pcase host
|
|
(`github (format "https://github.com/%s" repo))
|
|
(`gitlab (format "https://gitlab.com/%s" repo))
|
|
(`bitbucket (format "https://bitbucket.com/%s" (plist-get plist :repo)))
|
|
(`git repo)
|
|
(_ nil)))))
|
|
((or package-archive-contents
|
|
(progn (package-refresh-contents)
|
|
package-archive-contents))
|
|
(pcase (ignore-errors (package-desc-archive (cadr (assq package package-archive-contents))))
|
|
(`nil nil)
|
|
("org" "https://orgmode.org")
|
|
((or "melpa" "melpa-mirror")
|
|
(format "https://melpa.org/#/%s" package))
|
|
("gnu"
|
|
(format "https://elpa.gnu.org/packages/%s.html" package))
|
|
(archive
|
|
(if-let* ((src (cdr (assoc package package-archives))))
|
|
(format "%s" src)
|
|
(user-error "%s isn't installed through any known source (%s)"
|
|
package archive)))))
|
|
((user-error "Can't get homepage for %S package" package))))))
|
|
|
|
|
|
;;
|
|
;;; Commands
|
|
|
|
;;;###autoload
|
|
(defun doom/reload-packages ()
|
|
"Reload `doom-packages', `package' and `quelpa'."
|
|
(interactive)
|
|
;; HACK straight.el must be loaded for this to work
|
|
(message "Reloading packages")
|
|
(doom-initialize-packages t)
|
|
(message "Reloading packages...DONE"))
|
|
|
|
(defun doom--package-merge-recipes (package plist)
|
|
(require 'straight)
|
|
(doom-plist-merge
|
|
(plist-get plist :recipe)
|
|
(if-let* ((recipe (straight-recipes-retrieve package)))
|
|
(cdr (if (memq (car recipe) '(quote \`))
|
|
(eval recipe t)
|
|
recipe))
|
|
(let ((recipe (plist-get (cdr (assq package doom-packages))
|
|
:recipe)))
|
|
(if (keywordp (car recipe))
|
|
recipe
|
|
(cdr recipe))))))
|
|
|
|
(defun doom--package-to-bump-string (package plist)
|
|
"Return a PACKAGE and its PLIST in 'username/repo@commit' format."
|
|
(format "%s@%s"
|
|
(plist-get (doom--package-merge-recipes package plist) :repo)
|
|
(substring-no-properties (plist-get plist :pin) 0 12)))
|
|
|
|
(defun doom--package-at-point (&optional point)
|
|
"Return the package and plist from the (package! PACKAGE PLIST...) at point."
|
|
(save-match-data
|
|
(save-excursion
|
|
(and point (goto-char point))
|
|
(while (and (or (atom (sexp-at-point))
|
|
(doom-point-in-string-or-comment-p))
|
|
(search-backward "(" nil t)))
|
|
(when (eq (car-safe (sexp-at-point)) 'package!)
|
|
(cl-destructuring-bind (beg . end)
|
|
(bounds-of-thing-at-point 'sexp)
|
|
(let* ((doom-packages nil)
|
|
(buffer-file-name
|
|
(or buffer-file-name
|
|
(bound-and-true-p org-src-source-file-name)))
|
|
(package
|
|
(with-doom-context 'package
|
|
(with-doom-module (doom-module-from-path buffer-file-name)
|
|
(eval (sexp-at-point) t)))))
|
|
(list :beg beg
|
|
:end end
|
|
:package (car package)
|
|
:plist (cdr package))))))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bumpify-package-at-point ()
|
|
"Convert `package!' call at point to a bump string."
|
|
(interactive)
|
|
(cl-destructuring-bind (&key package plist beg end)
|
|
(doom--package-at-point)
|
|
(when-let (str (doom--package-to-bump-string package plist))
|
|
(goto-char beg)
|
|
(delete-region beg end)
|
|
(insert str))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bumpify-packages-in-buffer ()
|
|
"Convert all `package!' calls in buffer into bump strings."
|
|
(interactive)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (search-forward "(package!" nil t)
|
|
(unless (doom-point-in-string-or-comment-p)
|
|
(doom/bumpify-package-at-point)))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bump-package-at-point (&optional select)
|
|
"Inserts or updates a `:pin' for the `package!' statement at point.
|
|
Grabs the latest commit id of the package using 'git'."
|
|
(interactive "P")
|
|
(doom-initialize-packages)
|
|
(cl-destructuring-bind (&key package plist beg end)
|
|
(or (doom--package-at-point)
|
|
(user-error "Not on a `package!' call"))
|
|
(let* ((recipe (doom--package-merge-recipes package plist))
|
|
(branch (plist-get recipe :branch))
|
|
(oldid (or (plist-get plist :pin)
|
|
(doom-package-get package :pin)))
|
|
(url (straight-vc-git--destructure recipe (upstream-repo upstream-host)
|
|
(straight-vc-git--encode-url upstream-repo upstream-host)))
|
|
(id (or (when url
|
|
(cdr (doom-call-process
|
|
"git" "ls-remote" url
|
|
(unless select branch))))
|
|
(user-error "Couldn't find a recipe for %s" package)))
|
|
(id (car (split-string
|
|
(if select
|
|
(completing-read "Commit: " (split-string id "\n" t))
|
|
id)))))
|
|
(when (and oldid
|
|
(plist-member plist :pin)
|
|
(equal oldid id))
|
|
(user-error "%s: no update necessary" package))
|
|
(save-excursion
|
|
(if (re-search-forward ":pin +\"\\([^\"]+\\)\"" end t)
|
|
(replace-match id t t nil 1)
|
|
(goto-char (1- end))
|
|
(insert " :pin " (prin1-to-string id))))
|
|
(cond ((not oldid)
|
|
(message "%s: → %s" package (substring id 0 10)))
|
|
((< (length oldid) (length id))
|
|
(message "%s: extended to %s..." package id))
|
|
((message "%s: %s → %s"
|
|
package
|
|
(substring oldid 0 10)
|
|
(substring id 0 10)))))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bump-packages-in-buffer (&optional select)
|
|
"Inserts or updates a `:pin' to all `package!' statements in current buffer.
|
|
If SELECT (prefix arg) is non-nil, prompt you to choose a specific commit for
|
|
each package."
|
|
(interactive "P")
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(doom-initialize-packages)
|
|
(let (packages)
|
|
(while (search-forward "(package! " nil t)
|
|
(unless (let ((ppss (syntax-ppss)))
|
|
(or (nth 4 ppss)
|
|
(nth 3 ppss)
|
|
(save-excursion
|
|
(and (goto-char (match-beginning 0))
|
|
(not (plist-member (sexp-at-point) :pin))))))
|
|
(condition-case e
|
|
(push (doom/bump-package-at-point select) packages)
|
|
(user-error (message "%s" (error-message-string e))))))
|
|
(if packages
|
|
(message "Updated %d packages\n- %s" (length packages) (string-join packages "\n- "))
|
|
(message "No packages to update")))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bump-module (category &optional module select)
|
|
"Bump packages in CATEGORY MODULE.
|
|
If SELECT (prefix arg) is non-nil, prompt you to choose a specific commit for
|
|
each package."
|
|
(interactive
|
|
(let* ((module (completing-read
|
|
"Bump module: "
|
|
(let ((modules (doom-module-list 'all)))
|
|
(mapcar (lambda (m)
|
|
(if (listp m)
|
|
(format "%s %s" (car m) (cdr m))
|
|
(format "%s" m)))
|
|
(append (delete-dups (mapcar #'car modules))
|
|
modules)))
|
|
nil t nil nil))
|
|
(module (split-string module " " t)))
|
|
(list (intern (car module))
|
|
(ignore-errors (intern (cadr module)))
|
|
current-prefix-arg)))
|
|
(mapc (lambda! (key)
|
|
(if-let* ((packages-file (doom-module-locate-path key doom-module-packages-file)))
|
|
(with-current-buffer
|
|
(or (get-file-buffer packages-file)
|
|
(find-file-noselect packages-file))
|
|
(doom/bump-packages-in-buffer select)
|
|
(save-buffer))
|
|
(message "Module %s has no packages.el file" key)))
|
|
(if module
|
|
(list (cons category module))
|
|
(cl-remove-if-not (lambda (m) (eq (car m) category))
|
|
(doom-module-list 'all)))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bump-package (package)
|
|
"Bump PACKAGE in all modules that install it."
|
|
(interactive
|
|
(list (intern (completing-read "Bump package: "
|
|
(mapcar #'car (doom-package-list 'all))))))
|
|
(let* ((packages (doom-package-list 'all))
|
|
(modules (plist-get (alist-get package packages) :modules)))
|
|
(unless modules
|
|
(user-error "This package isn't installed by any Doom module"))
|
|
(dolist (module modules)
|
|
(when (doom-module-locate-path module doom-module-packages-file)
|
|
(doom/bump-module (car module) (cdr module))))))
|
|
|
|
;;;###autoload
|
|
(defun doom/bumpify-diff (&optional interactive)
|
|
"Copy user/repo@hash -> user/repo@hash's of changed packages to clipboard.
|
|
|
|
Must be run from a magit diff buffer."
|
|
(interactive (list 'interactive))
|
|
(save-window-excursion
|
|
(magit-diff-staged)
|
|
(unless (eq major-mode 'magit-diff-mode)
|
|
(user-error "Not in a magit diff buffer"))
|
|
(goto-char (point-min))
|
|
(letf! (defun read-package ()
|
|
(let* ((file (magit-file-at-point))
|
|
(visited? (if file (get-file-buffer file))))
|
|
(save-window-excursion
|
|
(call-interactively #'magit-diff-visit-file)
|
|
(unwind-protect
|
|
(and (or (looking-at-p "(package!")
|
|
(re-search-forward "(package! " (line-end-position) t)
|
|
(re-search-backward "(package! " nil t))
|
|
(let* ((buffer-file-name file)
|
|
(plist (doom--package-at-point)))
|
|
(cons (plist-get plist :package)
|
|
plist)))
|
|
(unless visited?
|
|
(kill-current-buffer))))))
|
|
(let (targets
|
|
before
|
|
after
|
|
lines
|
|
errors)
|
|
(save-excursion
|
|
(while (re-search-forward "^modified +\\(.+\\)$" nil t)
|
|
(cl-pushnew (doom-module-from-path (match-string 1)) targets
|
|
:test #'equal)))
|
|
(save-excursion
|
|
(while (re-search-forward "^-" nil t)
|
|
(when-let (pkg (read-package))
|
|
(cl-pushnew pkg before :test #'equal))))
|
|
(save-excursion
|
|
(while (re-search-forward "^+" nil t)
|
|
(when-let (pkg (read-package))
|
|
(cl-pushnew pkg after :test #'equal))))
|
|
(unless (= (length before) (length after))
|
|
(user-error "Uneven number of packages being bumped"))
|
|
(dolist (p1 before)
|
|
(when (and (listp p1) (plist-get (cdr p1) :package))
|
|
(cl-destructuring-bind (package &key plist _beg _end &allow-other-keys) p1
|
|
(let ((p2 (cdr (assq package after))))
|
|
(if (null p2)
|
|
(push package errors)
|
|
(let ((bstr1 (doom--package-to-bump-string package plist))
|
|
(bstr2 (doom--package-to-bump-string package (plist-get p2 :plist))))
|
|
(cl-pushnew (format "%s -> %s" bstr1 bstr2) lines :test #'equal)))))))
|
|
(if (null lines)
|
|
(user-error "No bumps to bumpify")
|
|
(prog1 (funcall (if interactive #'kill-new #'identity)
|
|
(format "bump: %s\n\n%s"
|
|
(mapconcat (lambda (x)
|
|
(mapconcat #'symbol-name x " "))
|
|
(cl-loop with alist = ()
|
|
for (category . module) in (reverse targets)
|
|
do (setf (alist-get category alist)
|
|
(append (alist-get category alist) (list module)))
|
|
finally return alist)
|
|
" ")
|
|
(string-join (sort (reverse lines) #'string-lessp)
|
|
"\n")))
|
|
(when interactive
|
|
(message "Copied to clipboard"))))))))
|
|
|
|
;;;###autoload
|
|
(defun doom/commit-bumps ()
|
|
"Create a pre-filled magit commit for currently bumped packages."
|
|
(interactive)
|
|
(magit-commit-create
|
|
(list "-e" "-m" (doom/bumpify-diff))))
|
|
|
|
|
|
;;
|
|
;;; CLI API
|
|
|
|
(defun doom-packages--same-commit-p (abbrev-ref ref)
|
|
(and (stringp abbrev-ref)
|
|
(stringp ref)
|
|
(string-match-p (concat "^" (regexp-quote abbrev-ref))
|
|
ref)))
|
|
|
|
(defun doom-packages--abbrev-commit (commit &optional full)
|
|
(if full commit (substring commit 0 7)))
|
|
|
|
(defun doom-packages--commit-log-between (start-ref end-ref)
|
|
(straight--process-with-result
|
|
(straight--process-run
|
|
"git" "log" "--oneline" "--no-merges"
|
|
end-ref (concat "^" (regexp-quote start-ref)))
|
|
(if success
|
|
(string-trim-right (or stdout ""))
|
|
(format "ERROR: Couldn't collect commit list because: %s" stderr))))
|
|
|
|
(defmacro doom-packages--straight-with (form &rest body)
|
|
(declare (indent 1))
|
|
`(let-alist
|
|
(let* ((buffer (straight--process-buffer))
|
|
(start (with-current-buffer buffer (point-max)))
|
|
(retval ,form)
|
|
(output (with-current-buffer buffer (buffer-substring start (point-max)))))
|
|
(save-match-data
|
|
(list (cons 'it retval)
|
|
(cons 'stdout (substring-no-properties output))
|
|
(cons 'success (if (string-match "\n+\\[Return code: \\([0-9-]+\\)\\]\n+" output)
|
|
(string-to-number (match-string 1 output))))
|
|
(cons 'output (string-trim output
|
|
"^\\(\\$ [^\n]+\n\\)*\n+"
|
|
"\n+\\[Return code: [0-9-]+\\]\n+")))))
|
|
,@body))
|
|
|
|
(defun doom-packages--barf-if-incomplete ()
|
|
(let ((straight-safe-mode t))
|
|
(condition-case _ (straight-check-all)
|
|
(error (user-error "Package state is incomplete. Run 'doom sync' first")))))
|
|
|
|
(defmacro doom-packages--with-recipes (recipes binds &rest body)
|
|
(declare (indent 2))
|
|
(let ((recipe-var (make-symbol "recipe"))
|
|
(recipes-var (make-symbol "recipes")))
|
|
`(let* ((,recipes-var ,recipes)
|
|
(built ())
|
|
(straight-use-package-pre-build-functions
|
|
(cons (lambda (pkg &rest _) (cl-pushnew pkg built :test #'equal))
|
|
straight-use-package-pre-build-functions)))
|
|
(dolist (,recipe-var ,recipes-var (nreverse built))
|
|
(cl-block nil
|
|
(straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var)
|
|
,(ensure-list binds)
|
|
,@body))))))
|
|
|
|
(defvar doom-packages--cli-updated-recipes nil)
|
|
(defun doom-packages--cli-recipes-update ()
|
|
"Updates straight and recipe repos."
|
|
(unless doom-packages--cli-updated-recipes
|
|
(straight--make-build-cache-available)
|
|
(print! (start "Updating recipe repos..."))
|
|
(print-group!
|
|
(doom-packages--with-recipes
|
|
(delq
|
|
nil (mapcar (doom-rpartial #'gethash straight--repo-cache)
|
|
(mapcar #'symbol-name straight-recipe-repositories)))
|
|
(recipe package type local-repo)
|
|
(let ((esc (if init-file-debug "" "\033[1A"))
|
|
(ref (straight-vc-get-commit type local-repo))
|
|
newref output)
|
|
(print! (start "\rUpdating recipes for %s...%s") package esc)
|
|
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
|
(when .it
|
|
(setq output .output)
|
|
(straight-merge-package package)
|
|
(unless (equal ref (setq newref (straight-vc-get-commit type local-repo)))
|
|
(print! (success "\r%s updated (%s -> %s)")
|
|
package
|
|
(doom-packages--abbrev-commit ref)
|
|
(doom-packages--abbrev-commit newref))
|
|
(unless (string-empty-p output)
|
|
(print-group! (print! (item "%s" output))))))))))
|
|
(setq straight--recipe-lookup-cache (make-hash-table :test #'eq)
|
|
doom-packages--cli-updated-recipes t)))
|
|
|
|
(defvar doom-packages--eln-output-expected nil)
|
|
|
|
(defvar doom-packages--eln-output-path (car (bound-and-true-p native-comp-eln-load-path)))
|
|
|
|
(defun doom-packages--eln-file-name (file)
|
|
"Return the short .eln file name corresponding to `file'."
|
|
(file-name-concat
|
|
comp-native-version-dir
|
|
(file-name-nondirectory
|
|
(comp-el-to-eln-filename file))))
|
|
|
|
(defun doom-packages--eln-output-file (eln-name)
|
|
"Return the expected .eln file corresponding to `eln-name'."
|
|
(file-name-concat doom-packages--eln-output-path eln-name))
|
|
|
|
(defun doom-packages--eln-error-file (eln-name)
|
|
"Return the expected .error file corresponding to `eln-name'."
|
|
(file-name-concat doom-packages--eln-output-path eln-name ".error"))
|
|
|
|
(defun doom-packages--find-eln-file (eln-name)
|
|
"Find `eln-name' on the `native-comp-eln-load-path'."
|
|
(cl-some (fn! (file-exists-p! eln-name %))
|
|
native-comp-eln-load-path))
|
|
|
|
(defun doom-packages--elc-file-outdated-p (file)
|
|
"Check whether the corresponding .elc for `file' is outdated."
|
|
(let ((elc-file (byte-compile-dest-file file)))
|
|
;; NOTE Ignore missing elc files, they could be missing due to
|
|
;; `no-byte-compile'. Rebuilding unnecessarily is expensive.
|
|
(when (and (file-exists-p elc-file)
|
|
(file-newer-than-file-p file elc-file))
|
|
(doom-log "packages:elc: %s is newer than %s" file elc-file)
|
|
t)))
|
|
|
|
(defun doom-packages--eln-file-outdated-p (file)
|
|
"Check whether the corresponding .eln for `file' is outdated."
|
|
(when (file-exists-p file)
|
|
(let* ((eln-name (doom-packages--eln-file-name file))
|
|
(eln-file (doom-packages--find-eln-file eln-name))
|
|
(error-file (doom-packages--eln-error-file eln-name)))
|
|
(cond (eln-file
|
|
(when (file-newer-than-file-p file eln-file)
|
|
(doom-log "packages:eln: %s is newer than %s" file eln-file)
|
|
t))
|
|
((file-exists-p error-file)
|
|
(when (file-newer-than-file-p file error-file)
|
|
(doom-log "packages:eln: %s is newer than %s" file error-file)
|
|
t))))))
|
|
|
|
(defun doom-packages--native-compile-done-h (file)
|
|
"Callback fired when an item has finished async compilation."
|
|
(when file
|
|
(let* ((eln-name (doom-packages--eln-file-name file))
|
|
(eln-file (doom-packages--eln-output-file eln-name))
|
|
(error-file (doom-packages--eln-error-file eln-name)))
|
|
(if (file-exists-p eln-file)
|
|
(doom-log "packages:nativecomp: Compiled %s" eln-file)
|
|
(let ((error-dir (file-name-directory error-file)))
|
|
(if (not (file-writable-p error-dir))
|
|
(doom-log "packages:nativecomp: failed to write %s" error-file)
|
|
(make-directory error-dir 'parents)
|
|
(write-region "" nil error-file)
|
|
(doom-log "packages:nativecomp: wrote %s" error-file)))))))
|
|
|
|
(defun doom-packages--wait-for-native-compile-jobs ()
|
|
"Wait for all pending async native compilation jobs."
|
|
(cl-loop with previous = 0
|
|
with timeout = 30
|
|
with timer = 0
|
|
for pending = (+ (length comp-files-queue)
|
|
(if (functionp 'comp--async-runnings)
|
|
(comp--async-runnings)
|
|
(comp-async-runnings)))
|
|
while (not (zerop pending))
|
|
if (/= previous pending) do
|
|
(print! (start "\rNatively compiling %d files...\033[1A" pending))
|
|
(setq previous pending
|
|
timer 0)
|
|
else do
|
|
(let ((inhibit-message t))
|
|
(if (> timer timeout)
|
|
(cl-loop for file-name being each hash-key of comp-async-compilations
|
|
for prc = (gethash file-name comp-async-compilations)
|
|
unless (process-live-p prc)
|
|
do (setq timer 0)
|
|
and do (print! (warn "Native compilation of %S timed out" (path file-name)))
|
|
and return (kill-process prc))
|
|
(cl-incf timer 0.1))
|
|
(sleep-for 0.1))))
|
|
|
|
(defun doom-packages--write-missing-eln-errors ()
|
|
"Write .error files for any expected .eln files that are missing."
|
|
(cl-loop for file in doom-packages--eln-output-expected
|
|
for eln-name = (doom-packages--eln-file-name file)
|
|
for eln-file = (doom-packages--eln-output-file eln-name)
|
|
for error-file = (doom-packages--eln-error-file eln-name)
|
|
for error-dir = (file-name-directory error-file)
|
|
unless (or (file-exists-p eln-file)
|
|
(file-newer-than-file-p error-file file)
|
|
(not (file-writable-p error-dir)))
|
|
do (make-directory error-dir 'parents)
|
|
(write-region "" nil error-file)
|
|
(doom-log "Wrote %s" error-file))
|
|
(setq doom-packages--eln-output-expected nil))
|
|
|
|
(defun doom-packages--compile-site-files ()
|
|
"Queue async compilation for all non-doom Elisp files."
|
|
(cl-loop with paths = (cl-loop for path in load-path
|
|
unless (file-in-directory-p path doom-local-dir)
|
|
collect path)
|
|
for file in (doom-files-in paths :match "\\.el\\(?:\\.gz\\)?$")
|
|
if (and (file-exists-p (byte-compile-dest-file file))
|
|
(not (doom-packages--find-eln-file (doom-packages--eln-file-name file)))
|
|
(not (cl-some (fn! (string-match-p % file))
|
|
native-comp-deferred-compilation-deny-list))) do
|
|
(doom-log "Compiling %s" file)
|
|
(native-compile-async file)))
|
|
|
|
(defun doom-packages-ensure (&optional force-p)
|
|
"Ensure packages are installed, built"
|
|
(doom-initialize-packages)
|
|
(if (not (file-directory-p (straight--repos-dir)))
|
|
(print! (start "Installing all packages for the first time (this may take a while)..."))
|
|
(if force-p
|
|
(print! (start "Rebuilding all packages (this may take a while)..."))
|
|
(print! (start "Ensuring packages are installed and built..."))))
|
|
(print-group!
|
|
(let ((straight-check-for-modifications
|
|
(when (file-directory-p (straight--modified-dir))
|
|
'(find-when-checking)))
|
|
(straight--allow-find
|
|
(and straight-check-for-modifications
|
|
(executable-find straight-find-executable)
|
|
t))
|
|
(straight--packages-not-to-rebuild
|
|
(or straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
|
(straight--packages-to-rebuild
|
|
(or (if force-p :all straight--packages-to-rebuild)
|
|
(make-hash-table :test #'equal)))
|
|
(recipes (doom-package-recipe-alist))
|
|
(pinned (doom-package-pinned-alist)))
|
|
(add-hook 'native-comp-async-cu-done-functions #'doom-packages--native-compile-done-h)
|
|
(straight--make-build-cache-available)
|
|
(if-let* ((built
|
|
(doom-packages--with-recipes recipes (package local-repo recipe)
|
|
(let ((repo-dir (straight--repos-dir (or local-repo package)))
|
|
(build-dir (straight--build-dir package)))
|
|
(unless force-p
|
|
;; Ensure packages w/ outdated files/bytecode are rebuilt
|
|
(let* ((build (if (plist-member recipe :build)
|
|
(plist-get recipe :build)
|
|
t))
|
|
(want-byte-compile
|
|
(or (eq build t)
|
|
(memq 'compile build)))
|
|
(want-native-compile
|
|
(or (eq build t)
|
|
(memq 'native-compile build))))
|
|
(and (eq (car-safe build) :not)
|
|
(setq want-byte-compile (not want-byte-compile)
|
|
want-native-compile (not want-native-compile)))
|
|
(when (or (not (featurep 'native-compile))
|
|
(not straight--native-comp-available))
|
|
(setq want-native-compile nil))
|
|
(and (or want-byte-compile want-native-compile)
|
|
(or (file-newer-than-file-p repo-dir build-dir)
|
|
(file-exists-p (straight--modified-dir package))
|
|
(cl-loop with outdated = nil
|
|
for file in (doom-files-in build-dir :match "\\.el$" :full t)
|
|
if (or (if want-byte-compile (doom-packages--elc-file-outdated-p file))
|
|
(if want-native-compile (doom-packages--eln-file-outdated-p file)))
|
|
do (setq outdated t)
|
|
(when want-native-compile
|
|
(push file doom-packages--eln-output-expected))
|
|
finally return outdated))
|
|
(puthash package t straight--packages-to-rebuild))))
|
|
(unless (file-directory-p repo-dir)
|
|
(doom-packages--cli-recipes-update))
|
|
(condition-case-unless-debug e
|
|
(let ((straight-vc-git-post-clone-hook
|
|
(cons (lambda! (&key commit)
|
|
(print-group!
|
|
(if-let* ((pin (cdr (assoc package pinned))))
|
|
(print! (item "Pinned to %s") pin)
|
|
(when commit
|
|
(print! (item "Checked out %s") commit)))))
|
|
straight-vc-git-post-clone-hook)))
|
|
(straight-use-package (intern package))
|
|
(when (file-in-directory-p repo-dir straight-base-dir)
|
|
;; HACK: Straight can sometimes fail to clone a
|
|
;; repo, leaving behind an empty directory which,
|
|
;; in future invocations, it will assume
|
|
;; indicates a successful clone (causing load
|
|
;; errors later).
|
|
(let ((try 0))
|
|
(while (not (file-directory-p (doom-path repo-dir ".git")))
|
|
(when (= try 3)
|
|
(error "Failed to clone package"))
|
|
(print! (warn "Failed to clone %S, trying again (attempt #%d)...") package (1+ try))
|
|
(delete-directory repo-dir t)
|
|
(delete-directory build-dir t)
|
|
(straight-use-package (intern package))
|
|
(cl-incf try)))
|
|
;; HACK: Line encoding issues can plague repos with
|
|
;; dirty worktree prompts when updating packages
|
|
;; or "Local variables entry is missing the
|
|
;; suffix" errors when installing them (see
|
|
;; #2637), so have git handle conversion by
|
|
;; force.
|
|
(when doom--system-windows-p
|
|
(let ((default-directory repo-dir))
|
|
(straight--process-run "git" "config" "core.autocrlf" "true")))))
|
|
(error
|
|
(signal 'doom-package-error (list package e))))))))
|
|
(progn
|
|
(when (and (featurep 'native-compile)
|
|
straight--native-comp-available)
|
|
(doom-packages--compile-site-files)
|
|
(doom-packages--wait-for-native-compile-jobs)
|
|
(doom-packages--write-missing-eln-errors))
|
|
;; HACK: Every time you save a file in a package that straight
|
|
;; tracks, it is recorded in ~/.emacs.d/.local/straight/modified/.
|
|
;; Typically, straight will clean these up after rebuilding, but
|
|
;; Doom's use-case circumnavigates that, leaving these files there
|
|
;; and causing a rebuild of those packages each time `doom sync'
|
|
;; or similar is run, so we clean it up ourselves:
|
|
(delete-directory (straight--modified-dir) 'recursive)
|
|
(print! (success "\rBuilt %d package(s)") (length built)))
|
|
(print! (item "No packages need attention"))
|
|
nil))))
|
|
|
|
(defun doom-packages-update (&optional pinned-only-p)
|
|
"Updates packages."
|
|
(doom-initialize-packages)
|
|
(doom-packages--barf-if-incomplete)
|
|
(let* ((repo-dir (straight--repos-dir))
|
|
(pinned (doom-package-pinned-alist))
|
|
(recipes (doom-package-recipe-alist))
|
|
(packages-to-rebuild (make-hash-table :test 'equal))
|
|
(repos-to-rebuild (make-hash-table :test 'equal))
|
|
(total (length recipes))
|
|
(esc (if init-file-debug "" "\033[1A"))
|
|
(i 0))
|
|
(if pinned-only-p
|
|
(print! (start "Updating pinned packages..."))
|
|
(print! (start "Updating all packages (this may take a while)...")))
|
|
(doom-packages--with-recipes recipes (recipe package type local-repo)
|
|
(cl-incf i)
|
|
(print-group!
|
|
(unless (straight--repository-is-available-p recipe)
|
|
(print! (error "(%d/%d) Couldn't find local repo for %s") i total package)
|
|
(cl-return))
|
|
(when (gethash local-repo repos-to-rebuild)
|
|
(puthash package t packages-to-rebuild)
|
|
(print! (success "(%d/%d) %s was updated indirectly (with %s)") i total package local-repo)
|
|
(cl-return))
|
|
(let ((default-directory (straight--repos-dir local-repo)))
|
|
(unless (file-in-directory-p default-directory repo-dir)
|
|
(print! (warn "(%d/%d) Skipping %s because it is out-of-tree...") i total package)
|
|
(cl-return))
|
|
(when (eq type 'git)
|
|
(unless (file-exists-p ".git")
|
|
(error "%S is not a valid repository" package)))
|
|
(when (and pinned-only-p (not (assoc local-repo pinned)))
|
|
(cl-return))
|
|
(condition-case-unless-debug e
|
|
(let ((ref (straight-vc-get-commit type local-repo))
|
|
(target-ref
|
|
(cdr (or (assoc local-repo pinned)
|
|
(assoc package pinned))))
|
|
commits
|
|
output)
|
|
(or (cond
|
|
((not (stringp target-ref))
|
|
(print! (start "\r(%d/%d) Fetching %s...%s") i total package esc)
|
|
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
|
(when .it
|
|
(straight-merge-package package)
|
|
(setq target-ref (straight-vc-get-commit type local-repo))
|
|
(setq output (doom-packages--commit-log-between ref target-ref)
|
|
commits (length (split-string output "\n" t)))
|
|
(or (not (doom-packages--same-commit-p target-ref ref))
|
|
(cl-return)))))
|
|
|
|
((doom-packages--same-commit-p target-ref ref)
|
|
(print! (item "\r(%d/%d) %s is up-to-date...%s") i total package esc)
|
|
(cl-return))
|
|
|
|
((if (straight-vc-commit-present-p recipe target-ref)
|
|
(print! (start "\r(%d/%d) Checking out %s (%s)...%s")
|
|
i total package (doom-packages--abbrev-commit target-ref) esc)
|
|
(print! (start "\r(%d/%d) Fetching %s...%s") i total package esc)
|
|
(and (straight-vc-fetch-from-remote recipe)
|
|
(straight-vc-commit-present-p recipe target-ref)))
|
|
(straight-vc-check-out-commit recipe target-ref)
|
|
(or (not (eq type 'git))
|
|
(setq output (doom-packages--commit-log-between ref target-ref)
|
|
commits (length (split-string output "\n" t))))
|
|
(doom-packages--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
|
|
|
|
((print! (start "\r(%d/%d) Re-cloning %s...") i total local-repo esc)
|
|
(let ((repo (straight--repos-dir local-repo))
|
|
(straight-vc-git-default-clone-depth 'full))
|
|
(delete-directory repo 'recursive)
|
|
(print-group!
|
|
(straight-use-package (intern package) nil 'no-build))
|
|
(prog1 (file-directory-p repo)
|
|
(or (not (eq type 'git))
|
|
(setq output (doom-packages--commit-log-between ref target-ref)
|
|
commits (length (split-string output "\n" t))))))))
|
|
(progn
|
|
(print! (warn "\r(%d/%d) Failed to fetch %s")
|
|
i total local-repo)
|
|
(unless (string-empty-p output)
|
|
(print-group! (print! (item "%s" output))))
|
|
(cl-return)))
|
|
(puthash local-repo t repos-to-rebuild)
|
|
;; HACK: Rebuild all packages that depend on PACKAGE after
|
|
;; updating it. This ensures their bytecode don't contain stale
|
|
;; references to symbols in silent dependencies.
|
|
;; TODO: Allow `package!' to control this.
|
|
;; TODO: Add cache+optimization step for this rebuild table.
|
|
(letf! ((dependents (straight-dependents package))
|
|
(n 0)
|
|
(defun* add-to-rebuild (tree)
|
|
(cond ((null tree) nil)
|
|
((stringp tree)
|
|
(unless (gethash tree packages-to-rebuild)
|
|
(cl-incf n 1)
|
|
(puthash tree t packages-to-rebuild)))
|
|
((listp tree)
|
|
(add-to-rebuild (car tree))
|
|
(add-to-rebuild (cdr tree))))))
|
|
(add-to-rebuild dependents)
|
|
(puthash package t packages-to-rebuild)
|
|
(print! (success "\r(%d/%d) %s: %s -> %s%s%s")
|
|
i total local-repo
|
|
(doom-packages--abbrev-commit ref)
|
|
(doom-packages--abbrev-commit target-ref)
|
|
(if (and (integerp commits) (> commits 0))
|
|
(format " [%d commit(s)]" commits)
|
|
"")
|
|
(if (> n 0)
|
|
(format " (w/ %d dependents)" n)
|
|
"")))
|
|
(unless (string-empty-p output)
|
|
(let ((lines (split-string output "\n")))
|
|
(setq output
|
|
(if (> (length lines) 20)
|
|
(concat (string-join (cl-subseq (butlast lines 1) 0 20) "\n")
|
|
"\n[...]")
|
|
output)))
|
|
(print-group! (print! "%s" (indent output 2)))))
|
|
(user-error
|
|
(signal 'user-error (error-message-string e)))
|
|
(error
|
|
(signal 'doom-package-error (list package e)))))))
|
|
(print-group!
|
|
(if (hash-table-empty-p packages-to-rebuild)
|
|
(ignore (print! (success "\rAll %d packages are up-to-date") total))
|
|
(doom-packages--cli-recipes-update)
|
|
(straight--transaction-finalize)
|
|
(let ((default-directory (straight--build-dir)))
|
|
(mapc (doom-rpartial #'delete-directory 'recursive)
|
|
(hash-table-keys packages-to-rebuild)))
|
|
(print! (success "\rUpdated %d package(s)")
|
|
(hash-table-count packages-to-rebuild))
|
|
(doom-packages-ensure)
|
|
t))))
|
|
|
|
|
|
;;; PURGE (for the emperor)
|
|
(defun doom-packages--purge-build (build)
|
|
(let ((build-dir (straight--build-dir build)))
|
|
(delete-directory build-dir 'recursive)
|
|
(if (file-directory-p build-dir)
|
|
(ignore (print! (error "Failed to purg build/%s" build)))
|
|
(print! (success "Purged build/%s" build))
|
|
t)))
|
|
|
|
(defun doom-packages--purge-builds (builds)
|
|
(if (not builds)
|
|
(prog1 0
|
|
(print! (item "No builds to purge")))
|
|
(print! (start "Purging straight builds..." (length builds)))
|
|
(print-group!
|
|
(length
|
|
(delq nil (mapcar #'doom-packages--purge-build builds))))))
|
|
|
|
(cl-defun doom-packages--regraft-repo (repo)
|
|
(unless repo
|
|
(error "No repo specified for regrafting"))
|
|
(let ((default-directory (straight--repos-dir repo)))
|
|
(unless (file-directory-p ".git")
|
|
(print! (warn "\rrepos/%s is not a git repo, skipping" repo))
|
|
(cl-return))
|
|
(unless (file-in-directory-p default-directory straight-base-dir)
|
|
(print! (warn "\rSkipping repos/%s because it is local" repo))
|
|
(cl-return))
|
|
(let ((before-size (doom-directory-size default-directory)))
|
|
(doom-call-process "git" "reset" "--hard")
|
|
(doom-call-process "git" "clean" "-ffd")
|
|
(if (not (zerop (car (doom-call-process "git" "replace" "--graft" "HEAD"))))
|
|
(print! (item "\rrepos/%s is already compact\033[1A" repo))
|
|
(doom-call-process "git" "reflog" "expire" "--expire=all" "--all")
|
|
(doom-call-process "git" "gc" "--prune=now")
|
|
(let ((after-size (doom-directory-size default-directory)))
|
|
(if (equal after-size before-size)
|
|
(print! (success "\rrepos/%s cannot be compacted further" repo))
|
|
(print! (success "\rRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
|
repo before-size after-size)))))
|
|
t))
|
|
|
|
(defun doom-packages--regraft-repos (repos)
|
|
(if (not repos)
|
|
(prog1 0
|
|
(print! (item "No repos to regraft")))
|
|
(print! (start "Regrafting %d repos..." (length repos)))
|
|
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
|
(print-group!
|
|
(prog1 (delq nil (mapcar #'doom-packages--regraft-repo repos))
|
|
;; (princ "\r\033[K")
|
|
(let ((after-size (doom-directory-size (straight--repos-dir))))
|
|
(print! (success "\rFinished regrafting. Size before: %0.1fKB and after: %0.1fKB (%0.1fKB)")
|
|
before-size after-size
|
|
(- after-size before-size))))))))
|
|
|
|
(defun doom-packages--purge-repo (repo)
|
|
(let ((repo-dir (straight--repos-dir repo)))
|
|
(when (file-directory-p repo-dir)
|
|
(delete-directory repo-dir 'recursive)
|
|
(delete-file (straight--modified-file repo))
|
|
(if (file-directory-p repo-dir)
|
|
(ignore (print! (error "Failed to purge repos/%s" repo)))
|
|
(print! (success "Purged repos/%s" repo))
|
|
t))))
|
|
|
|
(defun doom-packages--purge-repos (repos)
|
|
(if (not repos)
|
|
(prog1 0
|
|
(print! (item "No repos to purge")))
|
|
(print! (start "Purging straight repositories..."))
|
|
(print-group!
|
|
(length
|
|
(delq nil (mapcar #'doom-packages--purge-repo repos))))))
|
|
|
|
(defun doom-packages--purge-elpa ()
|
|
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
|
|
(if (not dirs)
|
|
(prog1 0
|
|
(print! (item "No ELPA packages to purge")))
|
|
(print! (start "Purging ELPA packages..."))
|
|
(dolist (path dirs (length dirs))
|
|
(condition-case e
|
|
(print-group!
|
|
(if (file-directory-p path)
|
|
(delete-directory path 'recursive)
|
|
(delete-file path))
|
|
(print! (success "Deleted %s") (filename path)))
|
|
(error
|
|
(print! (error "Failed to delete %s because: %s")
|
|
(filename path)
|
|
e)))))))
|
|
|
|
(defun doom-packages--purge-eln ()
|
|
(if-let* ((dirs
|
|
(cl-delete (expand-file-name comp-native-version-dir doom-packages--eln-output-path)
|
|
(when (file-directory-p doom-packages--eln-output-path)
|
|
(directory-files doom-packages--eln-output-path t "^[^.]" t))
|
|
:test #'file-equal-p)))
|
|
(progn
|
|
(print! (start "Purging old native bytecode..."))
|
|
(print-group!
|
|
(dolist (dir dirs)
|
|
(print! (item "Deleting %S") (relpath dir doom-packages--eln-output-path))
|
|
(delete-directory dir 'recursive))
|
|
(print! (success "Purged %d directory(ies)" (length dirs))))
|
|
(length dirs))
|
|
(print! (item "No ELN directories to purge"))
|
|
0))
|
|
|
|
(defun doom-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p eln-p)
|
|
"Auto-removes orphaned packages and repos.
|
|
|
|
An orphaned package is a package that isn't a primary package (i.e. doesn't have
|
|
a `package!' declaration) or isn't depended on by another primary package.
|
|
|
|
If BUILDS-P, include straight package builds.
|
|
If REPOS-P, include straight repos.
|
|
If ELPA-P, include packages installed with package.el (M-x package-install)."
|
|
(doom-initialize-packages)
|
|
(doom-packages--barf-if-incomplete)
|
|
(print! (start "Purging orphaned packages (for the emperor)..."))
|
|
(quiet! (straight-prune-build-cache))
|
|
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
|
(let ((rdirs
|
|
(and (or repos-p regraft-repos-p)
|
|
(straight--directory-files (straight--repos-dir) nil nil 'sort))))
|
|
(list (when builds-p
|
|
(let ((default-directory (straight--build-dir)))
|
|
(seq-filter #'file-directory-p
|
|
(seq-remove (doom-rpartial #'gethash straight--profile-cache)
|
|
(straight--directory-files default-directory nil nil 'sort)))))
|
|
(when repos-p
|
|
(seq-remove (doom-rpartial #'straight--checkhash straight--repo-cache)
|
|
rdirs))
|
|
(when regraft-repos-p
|
|
(seq-filter (doom-rpartial #'straight--checkhash straight--repo-cache)
|
|
rdirs))))
|
|
(print-group!
|
|
(delq
|
|
nil (list
|
|
(if (not builds-p)
|
|
(ignore (print! (item "Skipping builds")))
|
|
(/= 0 (doom-packages--purge-builds builds-to-purge)))
|
|
(if (not elpa-p)
|
|
(ignore (print! (item "Skipping elpa packages")))
|
|
(/= 0 (doom-packages--purge-elpa)))
|
|
(if (not repos-p)
|
|
(ignore (print! (item "Skipping repos")))
|
|
(/= 0 (doom-packages--purge-repos repos-to-purge)))
|
|
(if (not regraft-repos-p)
|
|
(ignore (print! (item "Skipping regrafting")))
|
|
(doom-packages--regraft-repos repos-to-regraft))
|
|
(when (featurep 'native-compile)
|
|
(if (not eln-p)
|
|
(ignore (print! (item "Skipping native bytecode")))
|
|
(doom-packages--purge-eln))))))))
|
|
|
|
(provide 'doom-lib '(packages))
|
|
;;; packages.el ends here
|