dev: updating pr7002 from pr

This commit is contained in:
Matt Nish-Lapidus 2024-01-27 09:23:57 -05:00
commit ae03012599
20 changed files with 167 additions and 148 deletions

View file

@ -1050,9 +1050,9 @@ considered as well."
"\n"))) "\n")))
(print! (warn "Wrote extended straight log to %s") (print! (warn "Wrote extended straight log to %s")
(path (let ((coding-system-for-write 'utf-8-auto)) (path (let ((coding-system-for-write 'utf-8-auto))
(with-temp-file error-file (with-file-modes #o600
(insert-buffer-substring (straight--process-buffer))) (with-temp-file error-file
(set-file-modes error-file #o600) (insert-buffer-substring (straight--process-buffer))))
error-file)))) error-file))))
((eq type 'error) ((eq type 'error)
(let* ((generic? (eq (car data) 'error)) (let* ((generic? (eq (car data) 'error))
@ -1123,11 +1123,12 @@ See `doom-cli-log-file-format' for details."
(let* ((buffer (doom-cli-context-stderr context)) (let* ((buffer (doom-cli-context-stderr context))
(file (doom-cli--output-file "log" context))) (file (doom-cli--output-file "log" context)))
(when (> (buffer-size buffer) 0) (when (> (buffer-size buffer) 0)
(make-directory (file-name-directory file) t) (with-file-modes #o700
(with-temp-file file (make-directory (file-name-directory file) t))
(insert-buffer-substring buffer) (with-file-modes #o600
(ansi-color-filter-region (point-min) (point-max))) (with-temp-file file
(set-file-modes file #o600))))) (insert-buffer-substring buffer)
(ansi-color-filter-region (point-min) (point-max))))))))
(defun doom-cli--output-benchmark-h (context) (defun doom-cli--output-benchmark-h (context)
"Write this session's benchmark to stdout or stderr, depending. "Write this session's benchmark to stdout or stderr, depending.
@ -1351,10 +1352,11 @@ ARGS are options passed to less. If DOOMPAGER is set, ARGS are ignored."
((let ((tmpfile (doom-cli--output-file 'output context)) ((let ((tmpfile (doom-cli--output-file 'output context))
(coding-system-for-write 'utf-8-auto)) (coding-system-for-write 'utf-8-auto))
(make-directory (file-name-directory tmpfile) t) (with-file-modes #o700
(with-temp-file tmpfile (make-directory (file-name-directory tmpfile) t))
(insert-buffer-substring (doom-cli-context-stdout context))) (with-file-modes #o600
(set-file-modes tmpfile #o600) (with-temp-file tmpfile
(insert-buffer-substring (doom-cli-context-stdout context))))
(doom-cli--restart (doom-cli--restart
(format "%s <%s; rm -f%s %s" (format "%s <%s; rm -f%s %s"
(or pager (or pager

View file

@ -801,7 +801,7 @@ This macro accepts, in order:
func-forms))) func-forms)))
`(progn `(progn
,@defn-forms ,@defn-forms
(dolist (hook (nreverse ',hook-forms)) (dolist (hook ',(nreverse hook-forms))
(dolist (func (list ,@func-forms)) (dolist (func (list ,@func-forms))
,(if remove-p ,(if remove-p
`(remove-hook hook func ,local-p) `(remove-hook hook func ,local-p)

View file

@ -116,9 +116,9 @@
(push 'dynamic-modules features)) (push 'dynamic-modules features))
(if (fboundp #'json-parse-string) (if (fboundp #'json-parse-string)
(push 'jansson features)) (push 'jansson features))
(let ((inhibit-changing-match-data t)) (if (string-match-p "HARFBUZZ" system-configuration-features) ; no alternative
(if (string-match "HARFBUZZ" system-configuration-features) ; no alternative (push 'harfbuzz features))
(push 'harfbuzz features)))
;; The `native-compile' feature exists whether or not it is functional (e.g. ;; The `native-compile' feature exists whether or not it is functional (e.g.
;; libgcc is available or not). This seems silly, so pretend it doesn't exist if ;; libgcc is available or not). This seems silly, so pretend it doesn't exist if
;; it isn't functional. ;; it isn't functional.
@ -237,7 +237,7 @@ These files should not be shared across systems. By default, it is used by
Data files contain shared and long-lived data that Doom, Emacs, and their Data files contain shared and long-lived data that Doom, Emacs, and their
packages require to function correctly or at all. Deleting them by hand will packages require to function correctly or at all. Deleting them by hand will
cause breakage, and require user intervention (e.g. a 'doom sync' or 'doom env') cause breakage, and require user intervention (e.g. a `doom sync` or `doom env`)
to restore. to restore.
Use this for: server binaries, package source, pulled module libraries, Use this for: server binaries, package source, pulled module libraries,
@ -254,10 +254,10 @@ For profile-local data files, use `doom-profile-data-dir' instead.")
(file-name-concat doom-local-dir "cache/")) (file-name-concat doom-local-dir "cache/"))
"Where Doom stores its global cache files. "Where Doom stores its global cache files.
Cache files represent non-essential data that shouldn't be problematic when Cache files represent unessential data that shouldn't be problematic when
deleted (besides, perhaps, a one-time performance hit), lack portability (and so deleted (besides, perhaps, a one-time performance hit), lack portability (and so
shouldn't be copied to other systems/configs), and are regenerated when needed, shouldn't be copied to other systems/configs), and are regenerated when needed,
without user input (e.g. a 'doom sync'). without user input (e.g. a `doom sync`).
Some examples: images/data caches, elisp bytecode, natively compiled elisp, Some examples: images/data caches, elisp bytecode, natively compiled elisp,
session files, ELPA archives, authinfo files, org-persist, etc. session files, ELPA archives, authinfo files, org-persist, etc.
@ -273,11 +273,11 @@ For profile-local cache files, use `doom-profile-cache-dir' instead.")
(file-name-concat doom-local-dir "state/")) (file-name-concat doom-local-dir "state/"))
"Where Doom stores its global state files. "Where Doom stores its global state files.
State files contain non-essential, unportable, but persistent data which, if State files contain unessential, unportable, but persistent data which, if lost
lost won't cause breakage, but may be inconvenient as they cannot be won't cause breakage, but may be inconvenient as they cannot be automatically
automatically regenerated or restored. For example, a recently-opened file list regenerated or restored. For example, a recently-opened file list is not
is not essential, but losing it means losing this record, and restoring it essential, but losing it means losing this record, and restoring it requires
requires revisiting all those files. revisiting all those files.
Use this for: history, logs, user-saved data, autosaves/backup files, known Use this for: history, logs, user-saved data, autosaves/backup files, known
projects, recent files, bookmarks. projects, recent files, bookmarks.
@ -331,19 +331,20 @@ users).")
;; `file-remote-p'). You get a noteable boost to startup time by unsetting ;; `file-remote-p'). You get a noteable boost to startup time by unsetting
;; or simplifying its value. ;; or simplifying its value.
(let ((old-value (default-toplevel-value 'file-name-handler-alist))) (let ((old-value (default-toplevel-value 'file-name-handler-alist)))
(setq file-name-handler-alist (set-default-toplevel-value
;; HACK: If the bundled elisp for this Emacs install isn't 'file-name-handler-alist
;; byte-compiled (but is compressed), then leave the gzip file ;; HACK: If the bundled elisp for this Emacs install isn't byte-compiled
;; handler there so Emacs won't forget how to read read them. ;; (but is compressed), then leave the gzip file handler there so Emacs
;; ;; won't forget how to read read them.
;; calc-loaddefs.el is our heuristic for this because it is built-in ;;
;; to all supported versions of Emacs, and calc.el explicitly loads ;; calc-loaddefs.el is our heuristic for this because it is built-in to
;; it uncompiled. This ensures that the only other, possible ;; all supported versions of Emacs, and calc.el explicitly loads it
;; fallback would be calc-loaddefs.el.gz. ;; uncompiled. This ensures that the only other, possible fallback would
(if (eval-when-compile ;; be calc-loaddefs.el.gz.
(locate-file-internal "calc-loaddefs.el" load-path)) (if (eval-when-compile
nil (locate-file-internal "calc-loaddefs.el" load-path))
(list (rassq 'jka-compr-handler old-value)))) nil
(list (rassq 'jka-compr-handler old-value))))
;; Make sure the new value survives any current let-binding. ;; Make sure the new value survives any current let-binding.
(set-default-toplevel-value 'file-name-handler-alist file-name-handler-alist) (set-default-toplevel-value 'file-name-handler-alist file-name-handler-alist)
;; Remember it so it can be reset where needed. ;; Remember it so it can be reset where needed.
@ -352,10 +353,11 @@ users).")
;; needed for handling encrypted or compressed files, among other things. ;; needed for handling encrypted or compressed files, among other things.
(add-hook! 'emacs-startup-hook :depth 101 (add-hook! 'emacs-startup-hook :depth 101
(defun doom--reset-file-handler-alist-h () (defun doom--reset-file-handler-alist-h ()
(setq file-name-handler-alist (set-default-toplevel-value
;; Merge instead of overwrite because there may have been changes to 'file-name-handler-alist
;; `file-name-handler-alist' since startup we want to preserve. ;; Merge instead of overwrite because there may have been changes to
(delete-dups (append file-name-handler-alist old-value)))))) ;; `file-name-handler-alist' since startup we want to preserve.
(delete-dups (append file-name-handler-alist old-value))))))
(unless noninteractive (unless noninteractive
;; PERF: Resizing the Emacs frame (to accommodate fonts that are smaller or ;; PERF: Resizing the Emacs frame (to accommodate fonts that are smaller or
@ -409,23 +411,23 @@ users).")
(define-advice startup--load-user-init-file (:before (&rest _) undo-silence) (define-advice startup--load-user-init-file (:before (&rest _) undo-silence)
(advice-remove #'load-file #'load-file@silence)) (advice-remove #'load-file #'load-file@silence))
;; PERF: `load-suffixes' and `load-file-rep-suffixes' are consulted on each ;; PERF: `load-suffixes' and `load-file-rep-suffixes' are consulted on
;; `require' and `load'. Doom won't load any dmodules this early, so omit ;; each `require' and `load'. Doom won't load any modules this early, so
;; .so for a small startup boost. This is later restored in doom-start. ;; omit .so for a tiny startup boost. Is later restored in doom-start.
(put 'load-suffixes 'initial-value (default-toplevel-value 'load-suffixes)) (put 'load-suffixes 'initial-value (default-toplevel-value 'load-suffixes))
(put 'load-file-rep-suffixes 'initial-value (default-toplevel-value 'load-file-rep-suffixes)) (put 'load-file-rep-suffixes 'initial-value (default-toplevel-value 'load-file-rep-suffixes))
(set-default-toplevel-value 'load-suffixes '(".elc" ".el")) (set-default-toplevel-value 'load-suffixes '(".elc" ".el"))
(set-default-toplevel-value 'load-file-rep-suffixes '("")) (set-default-toplevel-value 'load-file-rep-suffixes '(""))
;; COMPAT: Undo any problematic startup optimizations; from this point, I make ;; COMPAT: Undo any problematic startup optimizations; from this point, I
;; no assumptions about what might be loaded in userland. ;; make no assumptions about what might be loaded in userland.
(add-hook! 'doom-before-init-hook (add-hook! 'doom-before-init-hook
(defun doom--reset-load-suffixes-h () (defun doom--reset-load-suffixes-h ()
(setq load-suffixes (get 'load-suffixes 'initial-value) (setq load-suffixes (get 'load-suffixes 'initial-value)
load-file-rep-suffixes (get 'load-file-rep-suffixes 'initial-value)))) load-file-rep-suffixes (get 'load-file-rep-suffixes 'initial-value))))
;; PERF: Doom uses `defcustom' to indicate variables that users are expected ;; PERF: Doom uses `defcustom' to indicate variables that users are
;; to reconfigure. Trouble is it fires off initializers meant to ;; expected to reconfigure. Trouble is it fires off initializers meant
;; accommodate any user attempts to configure them before they were ;; to accommodate any user attempts to configure them before they were
;; defined. This is unnecessary before $DOOMDIR/init.el is loaded, so I ;; defined. This is unnecessary before $DOOMDIR/init.el is loaded, so I
;; disable them until it is. ;; disable them until it is.
(setq custom-dont-initialize t) (setq custom-dont-initialize t)
@ -434,8 +436,8 @@ users).")
(setq custom-dont-initialize nil))) (setq custom-dont-initialize nil)))
;; PERF: The mode-line procs a couple dozen times during startup. This is ;; PERF: The mode-line procs a couple dozen times during startup. This is
;; normally quite fast, but disabling the default mode-line and reducing the ;; normally quite fast, but disabling the default mode-line and reducing
;; update delay timer seems to stave off ~30-50ms. ;; the update delay timer seems to stave off ~30-50ms.
(put 'mode-line-format 'initial-value (default-toplevel-value 'mode-line-format)) (put 'mode-line-format 'initial-value (default-toplevel-value 'mode-line-format))
(setq-default mode-line-format nil) (setq-default mode-line-format nil)
(dolist (buf (buffer-list)) (dolist (buf (buffer-list))
@ -444,8 +446,8 @@ users).")
;; produce ugly flashes of unstyled Emacs. ;; produce ugly flashes of unstyled Emacs.
(setq-default inhibit-redisplay t (setq-default inhibit-redisplay t
inhibit-message t) inhibit-message t)
;; COMPAT: Then reset it with advice, because `startup--load-user-init-file' ;; COMPAT: Then reset with advice, because `startup--load-user-init-file'
;; will never be interrupted by errors. And if these settings are left ;; will never be interrupted by errors. And if these settings are left
;; set, Emacs could appear frozen or garbled. ;; set, Emacs could appear frozen or garbled.
(defun doom--reset-inhibited-vars-h () (defun doom--reset-inhibited-vars-h ()
(setq-default inhibit-redisplay nil (setq-default inhibit-redisplay nil
@ -459,8 +461,8 @@ users).")
(unless (default-toplevel-value 'mode-line-format) (unless (default-toplevel-value 'mode-line-format)
(setq-default mode-line-format (get 'mode-line-format 'initial-value)))) (setq-default mode-line-format (get 'mode-line-format 'initial-value))))
;; PERF: Doom disables the UI elements by default, so that there's less for ;; PERF: Doom disables the UI elements by default, so that there's less
;; the frame to initialize. However, the toolbar is still populated ;; for the frame to initialize. However, the toolbar is still populated
;; regardless, so I lazy load it until tool-bar-mode is actually used. ;; regardless, so I lazy load it until tool-bar-mode is actually used.
(advice-add #'tool-bar-setup :override #'ignore) (advice-add #'tool-bar-setup :override #'ignore)
(define-advice startup--load-user-init-file (:before (&rest _) defer-tool-bar-setup) (define-advice startup--load-user-init-file (:before (&rest _) defer-tool-bar-setup)
@ -497,7 +499,7 @@ All valid contexts:
(put 'doom-context 'valid-values '(cli compile eval init modules packages reload doctor sandbox)) (put 'doom-context 'valid-values '(cli compile eval init modules packages reload doctor sandbox))
(put 'doom-context 'risky-local-variable t) (put 'doom-context 'risky-local-variable t)
(defun doom-context--check (context) (defun doom-context--assert (context)
(let ((valid (get 'doom-context 'valid-values))) (let ((valid (get 'doom-context 'valid-values)))
(unless (memq context valid) (unless (memq context valid)
(signal 'doom-context-error (signal 'doom-context-error
@ -512,7 +514,7 @@ All valid contexts:
Return non-nil if successful. Throws an error if CONTEXT is invalid." Return non-nil if successful. Throws an error if CONTEXT is invalid."
(unless (memq context doom-context) (unless (memq context doom-context)
(doom-context--check context) (doom-context--assert context)
(doom-log ":context: +%s %s" context doom-context) (doom-log ":context: +%s %s" context doom-context)
(push context doom-context))) (push context doom-context)))
@ -529,7 +531,7 @@ wasn't active when this was called."
(setq doom-context (delq context doom-context)))) (setq doom-context (delq context doom-context))))
(defmacro doom-context-with (contexts &rest body) (defmacro doom-context-with (contexts &rest body)
"Evaluate BODY with CONTEXT added to `doom-context'." "Evaluate BODY with CONTEXTS added to `doom-context'."
(declare (indent 1)) (declare (indent 1))
`(let ((doom-context doom-context)) `(let ((doom-context doom-context))
(dolist (context (ensure-list ,contexts)) (dolist (context (ensure-list ,contexts))

View file

@ -220,7 +220,7 @@ single file or nested compound statement of `and' and `or' statements."
(let* ((buffer-file-name (doom-path ,file)) (let* ((buffer-file-name (doom-path ,file))
(coding-system-for-read (or ,coding 'binary)) (coding-system-for-read (or ,coding 'binary))
(coding-system-for-write (or coding-system-for-write coding-system-for-read 'binary))) (coding-system-for-write (or coding-system-for-write coding-system-for-read 'binary)))
(unless (eq coding-system-for-read 'binary) (when (eq coding-system-for-read 'binary)
(set-buffer-multibyte nil) (set-buffer-multibyte nil)
(setq-local buffer-file-coding-system 'binary)) (setq-local buffer-file-coding-system 'binary))
,@body)) ,@body))
@ -245,7 +245,8 @@ special values:
'read* -- read all forms in FILE and return it as a list of S-exps. 'read* -- read all forms in FILE and return it as a list of S-exps.
'(read . N) -- read the first N (an integer) S-exps in FILE. '(read . N) -- read the first N (an integer) S-exps in FILE.
CODING dictates the encoding of the buffer. This defaults to `utf-8'. CODING dictates the encoding of the buffer. This defaults to `utf-8'. If set to
nil, `binary' is used.
If NOERROR is non-nil, don't throw an error if FILE doesn't exist. This will If NOERROR is non-nil, don't throw an error if FILE doesn't exist. This will
still throw an error if FILE is unreadable, however. still throw an error if FILE is unreadable, however.
@ -301,18 +302,21 @@ If CONTENTS is list of forms. Any literal strings in the list are inserted
verbatim, as text followed by a newline, with `insert'. Sexps are inserted with verbatim, as text followed by a newline, with `insert'. Sexps are inserted with
`prin1'. BY is the function to use to emit `prin1'. BY is the function to use to emit
MODE dictates the permissions of the file. If FILE already exists, its MODE dictates the permissions of created file and directories. MODE is either an
permissions will be changed. integer or a cons cell whose car is the mode for files and cdr the mode for
directories. If FILE already exists, its permissions will be changed. The
permissions of existing directories will never be changed.
CODING dictates the encoding to read/write with (see `coding-system-for-write'). CODING dictates the encoding to read/write with (see `coding-system-for-write').
If set to nil, `binary' is used. This defaults to `utf-8'. If set to nil, `binary' is used.
APPEND dictates where CONTENTS will be written. If neither is set, APPEND dictates where CONTENTS will be written. If neither is set,
the file will be overwritten. If both are, the contents will be written to both the file will be overwritten. If both are, the contents will be written to both
ends. Set either APPEND or PREPEND to `noerror' to silently ignore read errors." ends. Set either APPEND or PREPEND to `noerror' to silently ignore read errors."
(doom--with-prepared-file-buffer file coding mode (let ((mode (ensure-list mode))
(let ((contents (ensure-list contents)) (contents (ensure-list contents))
datum) datum)
(doom--with-prepared-file-buffer file coding (car mode)
(while (setq datum (pop contents)) (while (setq datum (pop contents))
(cond ((stringp datum) (cond ((stringp datum)
(funcall (funcall
@ -325,15 +329,21 @@ ends. Set either APPEND or PREPEND to `noerror' to silently ignore read errors."
((let ((standard-output (current-buffer)) ((let ((standard-output (current-buffer))
(print-quoted t) (print-quoted t)
(print-level nil) (print-level nil)
(print-length nil)) (print-length nil)
(funcall printfn datum)))))) ;; Escape special chars to avoid any shenanigans
(let (write-region-annotate-functions (print-escape-newlines t)
write-region-post-annotation-function) (print-escape-control-characters t)
(when mkdir (print-escape-nonascii t)
(make-directory (file-name-directory buffer-file-name) (print-escape-multibyte t))
(eq mkdir 'parents))) (funcall printfn datum)))))
(write-region nil nil buffer-file-name append :silent)) (let (write-region-annotate-functions
buffer-file-name)) write-region-post-annotation-function)
(when mkdir
(with-file-modes (or (cdr mode) (default-file-modes))
(make-directory (file-name-directory buffer-file-name)
(eq mkdir 'parents))))
(write-region nil nil buffer-file-name append :silent))
buffer-file-name)))
;;;###autoload ;;;###autoload
(defmacro with-file-contents! (file &rest body) (defmacro with-file-contents! (file &rest body)

View file

@ -239,7 +239,7 @@ Must be run from a magit diff buffer."
(unless (= (length before) (length after)) (unless (= (length before) (length after))
(user-error "Uneven number of packages being bumped")) (user-error "Uneven number of packages being bumped"))
(dolist (p1 before) (dolist (p1 before)
(when (and (listp p1) (eq (car p1) 'package!)) (when (and (listp p1) (plist-get (cdr p1) :package))
(cl-destructuring-bind (package &key plist _beg _end &allow-other-keys) p1 (cl-destructuring-bind (package &key plist _beg _end &allow-other-keys) p1
(let ((p2 (cdr (assq package after)))) (let ((p2 (cdr (assq package after))))
(if (null p2) (if (null p2)

View file

@ -13,7 +13,9 @@
:in PATH :in PATH
Sets what directory to base the search out of. Defaults to the current project's root. Sets what directory to base the search out of. Defaults to the current project's root.
:recursive BOOL :recursive BOOL
Whether or not to search files recursively from the base directory." Whether or not to search files recursively from the base directory.
:args LIST
Arguments to be appended to `consult-ripgrep-args'."
(declare (indent defun)) (declare (indent defun))
(unless (executable-find "rg") (unless (executable-find "rg")
(user-error "Couldn't find ripgrep in your PATH")) (user-error "Couldn't find ripgrep in your PATH"))
@ -29,7 +31,7 @@
"--path-separator / --smart-case --no-heading " "--path-separator / --smart-case --no-heading "
"--with-filename --line-number --search-zip " "--with-filename --line-number --search-zip "
"--hidden -g !.git -g !.svn -g !.hg " "--hidden -g !.git -g !.svn -g !.hg "
(mapconcat #'shell-quote-argument args " "))) (mapconcat #'identity args " ")))
(prompt (if (stringp prompt) (string-trim prompt) "Search")) (prompt (if (stringp prompt) (string-trim prompt) "Search"))
(query (or query (query (or query
(when (doom-region-active-p) (when (doom-region-active-p)

View file

@ -59,11 +59,16 @@
(after! woman (after! woman
;; The woman-manpath default value does not necessarily match man. If we have ;; The woman-manpath default value does not necessarily match man. If we have
;; man available but aren't using it for performance reasons, we can extract ;; man available but aren't using it for performance reasons, we can extract
;; it's manpath. ;; its manpath.
(when (executable-find "man") (let ((manpath (cond
(setq woman-manpath ((executable-find "manpath")
(split-string (cdr (doom-call-process "man" "--path")) (split-string (cdr (doom-call-process "manpath"))
path-separator t)))) path-separator t))
((executable-find "man")
(split-string (cdr (doom-call-process "man" "--path"))
path-separator t)))))
(when manpath
(setq woman-manpath manpath))))
(use-package! drag-stuff (use-package! drag-stuff

View file

@ -18,50 +18,9 @@
(t (recurse (1+ attempt)))))) (t (recurse (1+ attempt))))))
(recurse 1)))) (recurse 1))))
;;;###autoload
(defun +lisp/load-project-systems ()
"Load all systems of the current Lisp project into Sly."
(interactive)
(thread-last (+lisp--project-asd-file)
(+lisp--systems-from-asd)
(mapcar (lambda (s) (format ":%s" s)))
(funcall (lambda (ss) (string-join ss " ")))
(format "(ql:quickload '(%s))")
(sly-interactive-eval)))
(defun +lisp--project-asd-file ()
"Yield an absolute file path to the current project's `.asd' file."
(let* ((proot (doom-project-root))
(files (doom-files-in proot :depth 1 :match "[.]asd$")))
(pcase files
('() (error "No .asd file found in: %s" proot))
(`(,asdf) asdf)
(_ (error "Too many .asd files found in : %s" proot)))))
(defun +lisp--systems-from-asd (asdf)
"Given a path to an ASDF project definition, extract the names of
the systems defined therein."
(let ((file (doom-file-read asdf))
(patt "defsystem \"\\([a-z-/]+\\)"))
(when (not (string-match patt file))
(error "No systems defined in: %s" asdf))
(thread-last (s-match-strings-all patt file)
(mapcar #'cl-second))))
;; TODO Get this to run in a comint buffer?
;;;###autoload
(defun +lisp/test-system ()
"Run `asdf:test-system' on the selected system of the current project."
(interactive)
(thread-last (+lisp--project-asd-file)
(+lisp--systems-from-asd)
(completing-read "Test which Lisp system?")
(format "(asdf:test-system :%s)")
(sly-interactive-eval)))
;;;###autoload ;;;###autoload
(defun +lisp/reload-project () (defun +lisp/reload-project ()
"Restart the Sly session and reload the current project." "Restart the Sly session and reload a chosen system."
(interactive) (interactive)
(sly-restart-inferior-lisp) (sly-restart-inferior-lisp)
(cl-labels ((recurse (attempt) (cl-labels ((recurse (attempt)
@ -72,7 +31,7 @@ the systems defined therein."
(error "Failed to reload Lisp project in 5 attempts.") (error "Failed to reload Lisp project in 5 attempts.")
(recurse (1+ attempt))))))) (recurse (1+ attempt)))))))
(recurse 1) (recurse 1)
(+lisp/load-project-systems))) (sly-asdf-load-system)))
;;;###autoload ;;;###autoload
(defun +lisp/find-file-in-quicklisp () (defun +lisp/find-file-in-quicklisp ()

View file

@ -141,7 +141,7 @@
:desc "Who sets" "S" #'sly-who-sets) :desc "Who sets" "S" #'sly-who-sets)
(:prefix ("r" . "repl") (:prefix ("r" . "repl")
:desc "Clear REPL" "c" #'sly-mrepl-clear-repl :desc "Clear REPL" "c" #'sly-mrepl-clear-repl
:desc "Load Project" "l" #'+lisp/load-project-systems :desc "Load System" "l" #'sly-asdf-load-system
:desc "Quit connection" "q" #'sly-quit-lisp :desc "Quit connection" "q" #'sly-quit-lisp
:desc "Restart connection" "r" #'sly-restart-inferior-lisp :desc "Restart connection" "r" #'sly-restart-inferior-lisp
:desc "Reload Project" "R" #'+lisp/reload-project :desc "Reload Project" "R" #'+lisp/reload-project
@ -154,7 +154,7 @@
:desc "Replay stickers" "r" #'sly-stickers-replay :desc "Replay stickers" "r" #'sly-stickers-replay
:desc "Add/remove sticker" "s" #'sly-stickers-dwim) :desc "Add/remove sticker" "s" #'sly-stickers-dwim)
(:prefix ("t" . "test") (:prefix ("t" . "test")
:desc "Test System" "s" #'+lisp/test-system) :desc "Test System" "s" #'sly-asdf-test-system)
(:prefix ("T" . "trace") (:prefix ("T" . "trace")
:desc "Toggle" "t" #'sly-toggle-trace-fdefinition :desc "Toggle" "t" #'sly-toggle-trace-fdefinition
:desc "Toggle (fancy)" "T" #'sly-toggle-fancy-trace :desc "Toggle (fancy)" "T" #'sly-toggle-fancy-trace
@ -168,3 +168,8 @@
:defer t :defer t
:init :init
(add-to-list 'sly-contribs 'sly-repl-ansi-color)) (add-to-list 'sly-contribs 'sly-repl-ansi-color))
(use-package! sly-asdf
:defer t
:init
(add-to-list 'sly-contribs 'sly-asdf 'append))

View file

@ -1,6 +1,7 @@
;; -*- no-byte-compile: t; -*- ;; -*- no-byte-compile: t; -*-
;;; lang/common-lisp/packages.el ;;; lang/common-lisp/packages.el
(when (package! sly :pin "f34c22289a2b3ab10e607f9f8822d62bb5c98cf5") (when (package! sly :pin "ed17d2c2bd7aead0fbb09c3d22861c80a522a097")
(package! sly-asdf :pin "6f9d751469bb82530db1673c22e7437ca6c95f45")
(package! sly-macrostep :pin "5113e4e926cd752b1d0bcc1508b3ebad5def5fad") (package! sly-macrostep :pin "5113e4e926cd752b1d0bcc1508b3ebad5def5fad")
(package! sly-repl-ansi-color :pin "b9cd52d1cf927bf7e08582d46ab0bcf1d4fb5048")) (package! sly-repl-ansi-color :pin "b9cd52d1cf927bf7e08582d46ab0bcf1d4fb5048"))

View file

@ -0,0 +1,5 @@
;;; lang/idris/doctor.el -*- lexical-binding: t; -*-
(when (require 'idris-mode nil t)
(unless (executable-find idris-interpreter-path)
(warn! "Cannot find the idris interpreter. Most features will not work.")))

View file

@ -182,19 +182,21 @@ Math faces should stay fixed by the mixed-pitch blacklist, this is mostly for
(dolist (env '("itemize" "enumerate" "description")) (dolist (env '("itemize" "enumerate" "description"))
(add-to-list 'LaTeX-indent-environment-list `(,env +latex-indent-item-fn))) (add-to-list 'LaTeX-indent-environment-list `(,env +latex-indent-item-fn)))
;; Fix #1849: allow fill-paragraph in itemize/enumerate. ;; Fix #1849: allow fill-paragraph in itemize/enumerate/description.
(defadvice! +latex--re-indent-itemize-and-enumerate-a (fn &rest args) (defadvice! +latex--re-indent-itemize-and-enumerate-and-description-a (fn &rest args)
:around #'LaTeX-fill-region-as-para-do :around #'LaTeX-fill-region-as-para-do
(let ((LaTeX-indent-environment-list (let ((LaTeX-indent-environment-list
(append LaTeX-indent-environment-list (append LaTeX-indent-environment-list
'(("itemize" +latex-indent-item-fn) '(("itemize" +latex-indent-item-fn)
("enumerate" +latex-indent-item-fn))))) ("enumerate" +latex-indent-item-fn)
("description" +latex-indent-item-fn)))))
(apply fn args))) (apply fn args)))
(defadvice! +latex--dont-indent-itemize-and-enumerate-a (fn &rest args) (defadvice! +latex--dont-indent-itemize-and-enumerate-and-description-a (fn &rest args)
:around #'LaTeX-fill-region-as-paragraph :around #'LaTeX-fill-region-as-paragraph
(let ((LaTeX-indent-environment-list LaTeX-indent-environment-list)) (let ((LaTeX-indent-environment-list LaTeX-indent-environment-list))
(delq! "itemize" LaTeX-indent-environment-list 'assoc) (delq! "itemize" LaTeX-indent-environment-list 'assoc)
(delq! "enumerate" LaTeX-indent-environment-list 'assoc) (delq! "enumerate" LaTeX-indent-environment-list 'assoc)
(delq! "description" LaTeX-indent-environment-list 'assoc)
(apply fn args)))) (apply fn args))))

View file

@ -852,6 +852,17 @@ can grow up to be fully-fledged org-mode buffers."
(add-hook 'doom-switch-buffer-hook #'+org--restart-mode-h (add-hook 'doom-switch-buffer-hook #'+org--restart-mode-h
nil 'local)))))) nil 'local))))))
(defadvice! +org--restart-mode-before-indirect-buffer-a (base-buffer &rest _)
"Restart `org-mode' in buffers in which the mode has been deferred (see
`+org-defer-mode-in-agenda-buffers-h') before they become the base buffer for an
indirect buffer. This ensures that the buffer is fully functional not only when
the *user* visits it, but also when some code interacts with it via an indirect
buffer as done, e.g., by `org-capture'."
:before #'make-indirect-buffer
(with-current-buffer base-buffer
(when (memq #'+org--restart-mode-h doom-switch-buffer-hook)
(+org--restart-mode-h))))
(defvar recentf-exclude) (defvar recentf-exclude)
(defadvice! +org--optimize-backgrounded-agenda-buffers-a (fn file) (defadvice! +org--optimize-backgrounded-agenda-buffers-a (fn file)
"Prevent temporarily opened agenda buffers from polluting recentf." "Prevent temporarily opened agenda buffers from polluting recentf."

View file

@ -9,5 +9,5 @@
(package! eshell-syntax-highlighting :pin "4ac27eec6595ba116a6151dfaf0b0e0440101e10") (package! eshell-syntax-highlighting :pin "4ac27eec6595ba116a6151dfaf0b0e0440101e10")
(unless IS-WINDOWS (unless IS-WINDOWS
(package! fish-completion :pin "df42e153082927536763bdf408184152a7c938c3") (package! fish-completion :pin "d34d0b96fde63feedf13c4288183d8d4d4d748cf")
(package! bash-completion :pin "f1daac0386c24cbe8a244a62c7588cc6847b07ae")) (package! bash-completion :pin "f1daac0386c24cbe8a244a62c7588cc6847b07ae"))

View file

@ -7,7 +7,7 @@
;; Example: ;; Example:
;; ((nil . ((ssh-deploy-root-local . "/local/path/to/project") ;; ((nil . ((ssh-deploy-root-local . "/local/path/to/project")
;; (ssh-deploy-root-remote . "/ssh:user@server:/remote/project/") ;; (ssh-deploy-root-remote . "/ssh:user@server:/remote/project/")
;; (ssh-deploy-on-explicit-save . t)))) ;; (ssh-deploy-on-explicit-save . 1))))
;; ;;
;; Note: `ssh-deploy-root-local' is optional, and will resort to ;; Note: `ssh-deploy-root-local' is optional, and will resort to
;; `doom-project-root' if unspecified. ;; `doom-project-root' if unspecified.
@ -20,7 +20,7 @@
ssh-deploy-remote-changes-handler) ssh-deploy-remote-changes-handler)
:init :init
(setq ssh-deploy-revision-folder (concat doom-cache-dir "ssh-revisions/") (setq ssh-deploy-revision-folder (concat doom-cache-dir "ssh-revisions/")
ssh-deploy-on-explicit-save t ssh-deploy-on-explicit-save 1
ssh-deploy-automatically-detect-remote-changes nil) ssh-deploy-automatically-detect-remote-changes nil)
;; Make these safe as file-local variables ;; Make these safe as file-local variables

View file

@ -1,5 +1,5 @@
;; -*- no-byte-compile: t; -*- ;; -*- no-byte-compile: t; -*-
;;; ui/doom/packages.el ;;; ui/doom/packages.el
(package! doom-themes :pin "4aee1f5a0e54552669f747aa7c25e6027e73d76d") (package! doom-themes :pin "ff26f26ea3d761375f5fc4070438fbd0f3473d33")
(package! solaire-mode :pin "8af65fbdc50b25ed3214da949b8a484527c7cc14") (package! solaire-mode :pin "8af65fbdc50b25ed3214da949b8a484527c7cc14")

View file

@ -2,7 +2,9 @@
(use-package! highlight-indent-guides (use-package! highlight-indent-guides
:hook ((prog-mode text-mode conf-mode) . highlight-indent-guides-mode) :hook ((prog-mode text-mode conf-mode) . highlight-indent-guides-mode)
:init (setq highlight-indent-guides-method 'character) :init
(setq highlight-indent-guides-method (if (display-graphic-p) 'bitmap 'character)
highlight-indent-guides-bitmap-function #'highlight-indent-guides--bitmap-line)
:config :config
;; HACK: If this package is loaded too early (by the user, and in terminal ;; HACK: If this package is loaded too early (by the user, and in terminal
;; Emacs), then `highlight-indent-guides-auto-set-faces' will have been ;; Emacs), then `highlight-indent-guides-auto-set-faces' will have been

View file

@ -2,7 +2,7 @@
;;; ui/modeline/packages.el ;;; ui/modeline/packages.el
(unless (modulep! +light) (unless (modulep! +light)
(package! doom-modeline :pin "93f240f7a0bf35511cfc0a8dd75786744b4bcf77")) (package! doom-modeline :pin "bf880ae56f3f6aab7bd334de9bd9b455c63a24c0"))
(package! anzu :pin "5abb37455ea44fa401d5f4c1bdc58adb2448db67") (package! anzu :pin "5abb37455ea44fa401d5f4c1bdc58adb2448db67")
(when (modulep! :editor evil) (when (modulep! :editor evil)
(package! evil-anzu :pin "d1e98ee6976437164627542909a25c6946497899")) (package! evil-anzu :pin "d1e98ee6976437164627542909a25c6946497899"))

View file

@ -505,11 +505,22 @@ Accepts the same arguments as `display-buffer-in-side-window'. You must set
((not (numberp vslot)) ((not (numberp vslot))
(error "Invalid vslot %s specified" vslot))) (error "Invalid vslot %s specified" vslot)))
(let* ((major (get-window-with-predicate (let* ((live (get-window-with-predicate
(lambda (window) (lambda (window)
(and (eq (window-parameter window 'window-side) side) (and (eq (window-parameter window 'window-side) side)
(eq (window-parameter window 'window-vslot) vslot))) (eq (window-parameter window 'window-vslot) vslot)))
nil)) nil))
;; As opposed to the `window-side' property, the `window-vslot'
;; property is set only on a single live window and never on internal
;; windows. Moreover, as opposed to `window-with-parameter' (as used
;; by the original `display-buffer-in-side-window'),
;; `get-window-with-predicate' only returns live windows anyway. In
;; any case, we will have missed the major side window and got a
;; child instead if the major side window happens to be an internal
;; window. In that case, the major side window is the parent of the
;; live window.
(major (and live
(if (window-next-sibling live) (window-parent live) live)))
(reversed (window--sides-reverse-on-frame-p (selected-frame))) (reversed (window--sides-reverse-on-frame-p (selected-frame)))
(windows (windows
(cond ((window-live-p major) (cond ((window-live-p major)

View file

@ -44,14 +44,14 @@
:to-contain '(size . 5))))) :to-contain '(size . 5)))))
(describe "popup rules" (describe "popup rules"
:var (origin a b c d e f g) :var (origin a b c d e f g h i)
(before-all (setq origin (current-buffer))) (before-all (setq origin (current-buffer)))
(before-each (before-each
(dolist (name '(a b c d e f g)) (dolist (name '(a b c d e f g h i))
(set name (get-buffer-create (symbol-name name))))) (set name (get-buffer-create (symbol-name name)))))
(after-each (after-each
(let (kill-buffer-query-functions kill-buffer-hook) (let (kill-buffer-query-functions kill-buffer-hook)
(dolist (x (list a b c d e f g)) (dolist (x (list a b c d e f g h i))
(ignore-errors (delete-window (get-buffer-window x))) (ignore-errors (delete-window (get-buffer-window x)))
(kill-buffer x)))) (kill-buffer x))))
@ -64,11 +64,13 @@
("d" :slot 2 :vslot 2) ("d" :slot 2 :vslot 2)
("e" :slot 1 :vslot 3) ("e" :slot 1 :vslot 3)
("f" :slot 1 :vslot 3) ("f" :slot 1 :vslot 3)
("g")))) ("g" :slot 2 :vslot 3)
("h" :slot 2 :vslot 3)
("i"))))
(it "replaces popups with the same slots" (it "replaces popups with the same slots"
(mapc #'display-buffer (list e f)) (mapc #'display-buffer (list e f g h))
(expect (length (+popup-windows)) :to-be 1)) (expect (length (+popup-windows)) :to-be 2))
(it "replaces popups among multiple that have the same slots" (it "replaces popups among multiple that have the same slots"
(let ((first (display-buffer a)) (let ((first (display-buffer a))
@ -92,7 +94,7 @@
(expect (window-in-direction 'right first t) (expect (window-in-direction 'right first t)
:to-equal second))) :to-equal second)))
(it "obeys default :slot" (it "obeys default :slot"
(let ((window (display-buffer g))) (let ((window (display-buffer i)))
(expect (window-parameter window 'window-slot) :to-be 1) (expect (window-parameter window 'window-slot) :to-be 1)
(expect (window-parameter window 'window-vslot) :to-be 1)))) (expect (window-parameter window 'window-vslot) :to-be 1))))