mirror of
https://gitlab.com/dwt1/dotfiles.git
synced 2026-04-23 19:40:24 +10:00
Updating Doom Emacs.
This commit is contained in:
Derek Taylor
@@ -1,198 +1,5 @@
|
||||
;;; core/autoload/packages.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Package metadata
|
||||
|
||||
;;;###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-recipe (package &optional prop nil-value)
|
||||
"Returns the `straight' recipe PACKAGE was registered with."
|
||||
(let ((plist (gethash (symbol-name package) straight--recipe-cache)))
|
||||
(if prop
|
||||
(if (plist-member plist prop)
|
||||
(plist-get plist prop)
|
||||
nil-value)
|
||||
plist)))
|
||||
|
||||
;;;###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-build-time (package)
|
||||
"TODO"
|
||||
(car (gethash (symbol-name package) straight--build-cache)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-dependencies (package &optional recursive noerror)
|
||||
"Return a list of dependencies for a package."
|
||||
(let ((deps (nth 1 (gethash (symbol-name package) straight--build-cache))))
|
||||
(if recursive
|
||||
(nconc deps (mapcan (lambda (dep) (doom-package-dependencies dep t t))
|
||||
deps))
|
||||
deps)))
|
||||
|
||||
(defun doom-package-depending-on (package &optional noerror)
|
||||
"Return a list of packages that depend on the package named NAME."
|
||||
(cl-check-type name symbol)
|
||||
;; can't get dependencies for built-in packages
|
||||
(unless (or (doom-package-build-recipe name)
|
||||
noerror)
|
||||
(error "Couldn't find %s, is it installed?" name))
|
||||
(cl-loop for pkg in (hash-table-keys straight--build-cache)
|
||||
for deps = (doom-package-dependencies pkg)
|
||||
if (memq package deps)
|
||||
collect pkg
|
||||
and append (doom-package-depending-on pkg t)))
|
||||
|
||||
|
||||
;;
|
||||
;;; 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-registered-p (package)
|
||||
"Return non-nil if PACKAGE (a symbol) has been registered with `package!'.
|
||||
|
||||
Excludes packages that have a non-nil :built-in property."
|
||||
(when-let (plist (doom-package-get package))
|
||||
(not (plist-get plist :ignore))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-private-p (package)
|
||||
"Return non-nil if PACKAGE was installed by the user's private config."
|
||||
(assq :private (doom-package-get package :modules)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-protected-p (package)
|
||||
"Return non-nil if PACKAGE is protected.
|
||||
|
||||
A protected package cannot be deleted and will be auto-installed if missing."
|
||||
(memq package doom-core-packages))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-core-p (package)
|
||||
"Return non-nil if PACKAGE is a core Doom package."
|
||||
(or (doom-package-protected-p package)
|
||||
(assq :core (doom-package-get package :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)
|
||||
('other)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-different-recipe-p (name)
|
||||
"Return t if a package named NAME (a symbol) has a different recipe than it
|
||||
was installed with."
|
||||
(cl-check-type name symbol)
|
||||
;; TODO
|
||||
;; (when (doom-package-installed-p name)
|
||||
;; (when-let* ((doom-recipe (assq name doom-packages))
|
||||
;; (install-recipe (doom-package-recipe)))
|
||||
;; (not (equal (cdr quelpa-recipe)
|
||||
;; (cdr (plist-get (cdr doom-recipe) :recipe))))))
|
||||
)
|
||||
|
||||
|
||||
;;
|
||||
;;; Package list getters
|
||||
|
||||
(defun doom--read-module-packages-file (file &optional noeval noerror)
|
||||
(with-temp-buffer ; prevent buffer-local settings from propagating
|
||||
(condition-case e
|
||||
(if (not noeval)
|
||||
(load file noerror t t)
|
||||
(when (file-readable-p file)
|
||||
(insert-file-contents file)
|
||||
(delay-mode-hooks (emacs-lisp-mode))
|
||||
(while (search-forward "(package! " nil t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(unless (let ((ppss (syntax-ppss)))
|
||||
(or (nth 3 ppss)
|
||||
(nth 4 ppss)))
|
||||
(cl-destructuring-bind (name . plist)
|
||||
(cdr (sexp-at-point))
|
||||
(push (cons
|
||||
name (plist-put
|
||||
plist :modules
|
||||
(list (doom-module-from-path file))))
|
||||
doom-packages)))))))
|
||||
((debug error)
|
||||
(signal 'doom-package-error
|
||||
(list (doom-module-from-path file)
|
||||
e))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-list (&optional all-p)
|
||||
"Retrieve a list of explicitly declared packages from enabled modules.
|
||||
|
||||
This excludes core packages listed in `doom-core-packages'.
|
||||
|
||||
If ALL-P, gather packages unconditionally across all modules, including disabled
|
||||
ones."
|
||||
(let ((doom-interactive-mode t)
|
||||
(doom-modules (doom-modules))
|
||||
doom-packages
|
||||
doom-disabled-packages)
|
||||
(doom--read-module-packages-file
|
||||
(doom-path doom-core-dir "packages.el") all-p t)
|
||||
(let ((private-packages (doom-path doom-private-dir "packages.el")))
|
||||
(unless all-p
|
||||
;; We load the private packages file twice to ensure disabled packages
|
||||
;; are seen ASAP, and a second time to ensure privately overridden
|
||||
;; packages are properly overwritten.
|
||||
(doom--read-module-packages-file private-packages nil t))
|
||||
(if all-p
|
||||
(mapc #'doom--read-module-packages-file
|
||||
(doom-files-in doom-modules-dir
|
||||
:depth 2
|
||||
:match "/packages\\.el$"))
|
||||
(cl-loop for key being the hash-keys of doom-modules
|
||||
for path = (doom-module-path (car key) (cdr key) "packages.el")
|
||||
for doom--current-module = key
|
||||
do (doom--read-module-packages-file path nil t)))
|
||||
(doom--read-module-packages-file private-packages all-p t))
|
||||
(nreverse doom-packages)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Main functions
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-packages ()
|
||||
"Reload `doom-packages', `package' and `quelpa'."
|
||||
@@ -201,3 +8,190 @@ ones."
|
||||
(message "Reloading packages")
|
||||
(doom-initialize-packages t)
|
||||
(message "Reloading packages...DONE"))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bump commands
|
||||
|
||||
(defun doom--package-full-recipe (package plist)
|
||||
(doom-plist-merge
|
||||
(plist-get plist :recipe)
|
||||
(or (cdr (straight-recipes-retrieve package))
|
||||
(plist-get (cdr (assq package doom-packages))
|
||||
: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-full-recipe package plist) :repo)
|
||||
(substring-no-properties (plist-get plist :pin) 0 7)))
|
||||
|
||||
(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 (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-full-recipe package plist))
|
||||
(branch (or (plist-get recipe :branch)
|
||||
straight-vc-git-default-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
|
||||
(or branch straight-vc-git-default-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' for the `package!' statement at point.
|
||||
Grabs the latest commit id of the package using 'git'."
|
||||
(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) 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 '(:private :core)
|
||||
(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 (fn! ((cat . mod))
|
||||
(if-let (packages-file
|
||||
(pcase cat
|
||||
(:private (doom-glob doom-private-dir "packages.el"))
|
||||
(:core (doom-glob doom-core-dir "packages.el"))
|
||||
(_ (doom-module-locate-path cat mod "packages.el"))))
|
||||
(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" (cons cat mod))))
|
||||
(if module
|
||||
(list (cons category module))
|
||||
(cl-remove-if-not (lambda (m) (eq (car m) category))
|
||||
(append '((:core) (:private))
|
||||
(doom-module-list 'all))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/bump-package (package)
|
||||
"Bump PACKAGE in all modules that install it."
|
||||
(interactive
|
||||
(list (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-let (packages-file (doom-module-locate-path (car module) (cdr module)))
|
||||
(doom/bump-module (car module) (cdr module))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bump commits
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/commit-bumps ()
|
||||
(interactive))
|
||||
|
||||
Reference in New Issue
Block a user