mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-01 12:17:25 -05:00
15904349cf
BREAKING CHANGE: This backports some architectural choices from v3.0.
This changes Doom's module API, renaming some functions and removing
others, in order to facilitate some new features, prepare to move Doom's
modules into separate repos, and make way for two, much larger breaking
commits coming in the next few days.
This commit won't break anything for users unless they're tinkering with
Doom's internals/using its `doom-module-*` API directly. I am avoiding
broader backwards incompatibilities until the 3.0 release.
What's new:
- Negated flags. (modulep! :editor evil -everywhere) will return non-nil
if :editor evil is active without its +everywhere flag.
- `modulep!` now takes multiple flags to simplify AND checks. E.g.
(and (modulep! +foo)
(modulep! +bar)
(not (modulep! +baz)))
Can now be expressed with:
(modulep! +foo +bar -baz)
- Adds pcase matchers for `doom-module-context` and `doom-module`
structs, making the following destructuring binds possible:
(pcase-dolist ((doom-module group name flags features)
(hash-table-values doom-modules))
...)
This will be used more in v3.0.
- Adds file cookie support to module init.el and config.el files.
Here's a summary of breaking changes made in this commit:
- `doom-module-context` was changed from a vector to a struct (record).
- `doom-modules` is now a table of `doom-module` structs, rather than
free-form plists.
- The following macros have been renamed:
- `doom-context-with` -> `with-doom-context`
- `doom-module-context-with` -> `with-doom-module`
- The followings functions have been replaced/removed:
- `doom-module-context`+`doom-module-context-get` -> `doom-module`
- `doom-module-set` -> `doom-module--put`
- `doom-module-p` -> `doom-module-active-p`
- `doom-module-context-key` (is now a getter with the same name)
- `doom-module-put` (removed)
- `doom-module--context-field` (removed)
- The signatures for these functions have changed:
- `doom-module-get CATEGORY &optional MODULE PROP` ->
`doom-module-get (GROUP . MODULE) &optional PROP`
- `doom-module-locate-path CATEGORY &optional MODULE FILE` ->
`doom-module-locate-path (GROUP . MODULE) &optional FILE`
- `doom-module-expand-path CATEGORY MODULE &optional FILE` ->
`doom-module-expand-path (GROUP . MODULE) &optional FILE`
- Adds the following functions
- `doom-module-exists-p`
- `doom-module-key`
- `doom-module->context`
- `doom-module<-context`
- Removes the following variables
- `doom-module--empty-context`
This commit results in a little redundancy, which I will address in
parts 2/3 and/or v3.0.
323 lines
14 KiB
EmacsLisp
323 lines
14 KiB
EmacsLisp
;;; lisp/lib/packages.el -*- lexical-binding: t; -*-
|
|
|
|
;;;###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"))
|
|
|
|
|
|
;;
|
|
;;; Bump commands
|
|
|
|
(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 'packages
|
|
(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))))))
|
|
|
|
|
|
;;
|
|
;;; Bump commits
|
|
|
|
;;;###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))))
|
|
|
|
|
|
;;
|
|
;;; Package metadata
|
|
|
|
;;;###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))))))
|
|
|
|
(provide 'doom-lib '(packages))
|
|
;;; packages.el ends here
|