refactor!: restructure Doom core
BREAKING CHANGE: This restructures the project in preparation for Doom to be split into two repos. Users that have reconfigured Doom's CLI stand a good chance of seeing breakage, especially if they've referred to any core-* feature, e.g. (after! core-cli-ci ...) To fix it, simply s/core-/doom-/, i.e. (after! doom-cli-ci ...) What this commit specifically changes is: - Renames all core features from core-* to doom-* - Moves core/core-* -> lisp/doom-* - Moves core/autoloads/* -> lisp/lib/* - Moves core/templates -> templates/ Ref: #4273
This commit is contained in:
Henrik Lissner
parent
a9866e37e4
commit
b9933e6637
69 changed files with 147 additions and 145 deletions
393
lisp/lib/buffers.el
Normal file
393
lisp/lib/buffers.el
Normal file
|
|
@ -0,0 +1,393 @@
|
|||
;;; lisp/lib/buffers.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-real-buffer-functions
|
||||
'(doom-dired-buffer-p)
|
||||
"A list of predicate functions run to determine if a buffer is real, unlike
|
||||
`doom-unreal-buffer-functions'. They are passed one argument: the buffer to be
|
||||
tested.
|
||||
|
||||
Should any of its function returns non-nil, the rest of the functions are
|
||||
ignored and the buffer is considered real.
|
||||
|
||||
See `doom-real-buffer-p' for more information.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-unreal-buffer-functions
|
||||
'(minibufferp doom-special-buffer-p doom-non-file-visiting-buffer-p)
|
||||
"A list of predicate functions run to determine if a buffer is *not* real,
|
||||
unlike `doom-real-buffer-functions'. They are passed one argument: the buffer to
|
||||
be tested.
|
||||
|
||||
Should any of these functions return non-nil, the rest of the functions are
|
||||
ignored and the buffer is considered unreal.
|
||||
|
||||
See `doom-real-buffer-p' for more information.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar-local doom-real-buffer-p nil
|
||||
"If non-nil, this buffer should be considered real no matter what. See
|
||||
`doom-real-buffer-p' for more information.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-fallback-buffer-name "*scratch*"
|
||||
"The name of the buffer to fall back to if no other buffers exist (will create
|
||||
it if it doesn't exist).")
|
||||
|
||||
|
||||
;;
|
||||
;;; Functions
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buffer-frame-predicate (buf)
|
||||
"To be used as the default frame buffer-predicate parameter. Returns nil if
|
||||
BUF should be skipped over by functions like `next-buffer' and `other-buffer'."
|
||||
(or (doom-real-buffer-p buf)
|
||||
(eq buf (doom-fallback-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-fallback-buffer ()
|
||||
"Returns the fallback buffer, creating it if necessary. By default this is the
|
||||
scratch buffer. See `doom-fallback-buffer-name' to change this."
|
||||
(let (buffer-list-update-hook)
|
||||
(get-buffer-create doom-fallback-buffer-name)))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'doom-buffer-list #'buffer-list)
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-buffer-list (&optional project)
|
||||
"Return a list of buffers belonging to the specified PROJECT.
|
||||
|
||||
If PROJECT is nil, default to the current project.
|
||||
|
||||
If no project is active, return all buffers."
|
||||
(let ((buffers (doom-buffer-list)))
|
||||
(if-let* ((project-root
|
||||
(if project (expand-file-name project)
|
||||
(doom-project-root))))
|
||||
(cl-loop for buf in buffers
|
||||
if (projectile-project-buffer-p buf project-root)
|
||||
collect buf)
|
||||
buffers)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-open-projects ()
|
||||
"Return a list of projects with open buffers."
|
||||
(cl-loop with projects = (make-hash-table :test 'equal :size 8)
|
||||
for buffer in (doom-buffer-list)
|
||||
if (buffer-live-p buffer)
|
||||
if (doom-real-buffer-p buffer)
|
||||
if (with-current-buffer buffer (doom-project-root))
|
||||
do (puthash (abbreviate-file-name it) t projects)
|
||||
finally return (hash-table-keys projects)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-dired-buffer-p (buf)
|
||||
"Returns non-nil if BUF is a dired buffer."
|
||||
(provided-mode-derived-p (buffer-local-value 'major-mode buf)
|
||||
'dired-mode))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-special-buffer-p (buf)
|
||||
"Returns non-nil if BUF's name starts and ends with an *."
|
||||
(equal (substring (buffer-name buf) 0 1) "*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-temp-buffer-p (buf)
|
||||
"Returns non-nil if BUF is temporary."
|
||||
(equal (substring (buffer-name buf) 0 1) " "))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-visible-buffer-p (buf)
|
||||
"Return non-nil if BUF is visible."
|
||||
(get-buffer-window buf))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buried-buffer-p (buf)
|
||||
"Return non-nil if BUF is not visible."
|
||||
(not (doom-visible-buffer-p buf)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-non-file-visiting-buffer-p (buf)
|
||||
"Returns non-nil if BUF does not have a value for `buffer-file-name'."
|
||||
(not (buffer-file-name buf)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-real-buffer-list (&optional buffer-list)
|
||||
"Return a list of buffers that satisfy `doom-real-buffer-p'."
|
||||
(cl-remove-if-not #'doom-real-buffer-p (or buffer-list (doom-buffer-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-real-buffer-p (buffer-or-name)
|
||||
"Returns t if BUFFER-OR-NAME is a 'real' buffer.
|
||||
|
||||
A real buffer is a useful buffer; a first class citizen in Doom. Real ones
|
||||
should get special treatment, because we will be spending most of our time in
|
||||
them. Unreal ones should be low-profile and easy to cast aside, so we can focus
|
||||
on real ones.
|
||||
|
||||
The exact criteria for a real buffer is:
|
||||
|
||||
1. A non-nil value for the buffer-local value of the `doom-real-buffer-p'
|
||||
variable OR
|
||||
2. Any function in `doom-real-buffer-functions' returns non-nil OR
|
||||
3. None of the functions in `doom-unreal-buffer-functions' must return
|
||||
non-nil.
|
||||
|
||||
If BUFFER-OR-NAME is omitted or nil, the current buffer is tested."
|
||||
(or (bufferp buffer-or-name)
|
||||
(stringp buffer-or-name)
|
||||
(signal 'wrong-type-argument (list '(bufferp stringp) buffer-or-name)))
|
||||
(when-let (buf (get-buffer buffer-or-name))
|
||||
(when-let (basebuf (buffer-base-buffer buf))
|
||||
(setq buf basebuf))
|
||||
(and (buffer-live-p buf)
|
||||
(not (doom-temp-buffer-p buf))
|
||||
(or (buffer-local-value 'doom-real-buffer-p buf)
|
||||
(run-hook-with-args-until-success 'doom-real-buffer-functions buf)
|
||||
(not (run-hook-with-args-until-success 'doom-unreal-buffer-functions buf))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-unreal-buffer-p (buffer-or-name)
|
||||
"Return t if BUFFER-OR-NAME is an 'unreal' buffer.
|
||||
|
||||
See `doom-real-buffer-p' for details on what that means."
|
||||
(not (doom-real-buffer-p buffer-or-name)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buffers-in-mode (modes &optional buffer-list derived-p)
|
||||
"Return a list of buffers whose `major-mode' is `eq' to MODE(S).
|
||||
|
||||
If DERIVED-P, test with `derived-mode-p', otherwise use `eq'."
|
||||
(let ((modes (doom-enlist modes)))
|
||||
(cl-remove-if-not (if derived-p
|
||||
(lambda (buf)
|
||||
(apply #'provided-mode-derived-p
|
||||
(buffer-local-value 'major-mode buf)
|
||||
modes))
|
||||
(lambda (buf)
|
||||
(memq (buffer-local-value 'major-mode buf) modes)))
|
||||
(or buffer-list (doom-buffer-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-visible-windows (&optional window-list)
|
||||
"Return a list of the visible, non-popup (dedicated) windows."
|
||||
(cl-loop for window in (or window-list (window-list))
|
||||
when (or (window-parameter window 'visible)
|
||||
(not (window-dedicated-p window)))
|
||||
collect window))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-visible-buffers (&optional buffer-list)
|
||||
"Return a list of visible buffers (i.e. not buried)."
|
||||
(let ((buffers (delete-dups (mapcar #'window-buffer (window-list)))))
|
||||
(if buffer-list
|
||||
(cl-delete-if (lambda (b) (memq b buffer-list))
|
||||
buffers)
|
||||
(delete-dups buffers))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-buried-buffers (&optional buffer-list)
|
||||
"Get a list of buffers that are buried."
|
||||
(cl-remove-if #'get-buffer-window (or buffer-list (doom-buffer-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-matching-buffers (pattern &optional buffer-list)
|
||||
"Get a list of all buffers that match the regex PATTERN."
|
||||
(cl-loop for buf in (or buffer-list (doom-buffer-list))
|
||||
when (string-match-p pattern (buffer-name buf))
|
||||
collect buf))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-set-buffer-real (buffer flag)
|
||||
"Forcibly mark BUFFER as FLAG (non-nil = real).
|
||||
|
||||
See `doom-real-buffer-p' for an explanation for real buffers."
|
||||
(with-current-buffer buffer
|
||||
(setq doom-real-buffer-p flag)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-buffer-and-windows (buffer)
|
||||
"Kill the buffer and delete all the windows it's displayed in."
|
||||
(dolist (window (get-buffer-window-list buffer))
|
||||
(unless (one-window-p t)
|
||||
(delete-window window)))
|
||||
(kill-buffer buffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-fixup-windows (windows)
|
||||
"Ensure that each of WINDOWS is showing a real buffer or the fallback buffer."
|
||||
(dolist (window windows)
|
||||
(with-selected-window window
|
||||
(when (doom-unreal-buffer-p (window-buffer))
|
||||
(previous-buffer)
|
||||
(when (doom-unreal-buffer-p (window-buffer))
|
||||
(switch-to-buffer (doom-fallback-buffer)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-buffer-fixup-windows (buffer)
|
||||
"Kill the BUFFER and ensure all the windows it was displayed in have switched
|
||||
to a real buffer or the fallback buffer."
|
||||
(let ((windows (get-buffer-window-list buffer)))
|
||||
(kill-buffer buffer)
|
||||
(doom-fixup-windows (cl-remove-if-not #'window-live-p windows))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-buffers-fixup-windows (buffers)
|
||||
"Kill the BUFFERS and ensure all the windows they were displayed in have
|
||||
switched to a real buffer or the fallback buffer."
|
||||
(let ((seen-windows (make-hash-table :test 'eq :size 8)))
|
||||
(dolist (buffer buffers)
|
||||
(let ((windows (get-buffer-window-list buffer)))
|
||||
(kill-buffer buffer)
|
||||
(dolist (window (cl-remove-if-not #'window-live-p windows))
|
||||
(puthash window t seen-windows))))
|
||||
(doom-fixup-windows (hash-table-keys seen-windows))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-kill-matching-buffers (pattern &optional buffer-list)
|
||||
"Kill all buffers (in current workspace OR in BUFFER-LIST) that match the
|
||||
regex PATTERN. Returns the number of killed buffers."
|
||||
(let ((buffers (doom-matching-buffers pattern buffer-list)))
|
||||
(dolist (buf buffers (length buffers))
|
||||
(kill-buffer buf))))
|
||||
|
||||
|
||||
;;
|
||||
;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-mark-buffer-as-real-h ()
|
||||
"Hook function that marks the current buffer as real.
|
||||
|
||||
See `doom-real-buffer-p' for an explanation for real buffers."
|
||||
(doom-set-buffer-real (current-buffer) t))
|
||||
|
||||
|
||||
;;
|
||||
;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/save-and-kill-buffer ()
|
||||
"Save the current buffer to file, then kill it."
|
||||
(interactive)
|
||||
(save-buffer)
|
||||
(kill-current-buffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-this-buffer-in-all-windows (buffer &optional dont-save)
|
||||
"Kill BUFFER globally and ensure all windows previously showing this buffer
|
||||
have switched to a real buffer or the fallback buffer.
|
||||
|
||||
If DONT-SAVE, don't prompt to save modified buffers (discarding their changes)."
|
||||
(interactive
|
||||
(list (current-buffer) current-prefix-arg))
|
||||
(cl-assert (bufferp buffer) t)
|
||||
(when (and (buffer-modified-p buffer) dont-save)
|
||||
(with-current-buffer buffer
|
||||
(set-buffer-modified-p nil)))
|
||||
(doom-kill-buffer-fixup-windows buffer))
|
||||
|
||||
|
||||
(defun doom--message-or-count (interactive message count)
|
||||
(if interactive
|
||||
(message message count)
|
||||
count))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-all-buffers (&optional buffer-list interactive)
|
||||
"Kill all buffers and closes their windows.
|
||||
|
||||
If the prefix arg is passed, doesn't close windows and only kill buffers that
|
||||
belong to the current project."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(doom-project-buffer-list)
|
||||
(doom-buffer-list))
|
||||
t))
|
||||
(if (null buffer-list)
|
||||
(message "No buffers to kill")
|
||||
(save-some-buffers)
|
||||
(delete-other-windows)
|
||||
(when (memq (current-buffer) buffer-list)
|
||||
(switch-to-buffer (doom-fallback-buffer)))
|
||||
(mapc #'kill-buffer buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-other-buffers (&optional buffer-list interactive)
|
||||
"Kill all other buffers (besides the current one).
|
||||
|
||||
If the prefix arg is passed, kill only buffers that belong to the current
|
||||
project."
|
||||
(interactive
|
||||
(list (delq (current-buffer)
|
||||
(if current-prefix-arg
|
||||
(doom-project-buffer-list)
|
||||
(doom-buffer-list)))
|
||||
t))
|
||||
(mapc #'doom-kill-buffer-and-windows buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d other buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-matching-buffers (pattern &optional buffer-list interactive)
|
||||
"Kill buffers that match PATTERN in BUFFER-LIST.
|
||||
|
||||
If the prefix arg is passed, only kill matching buffers in the current project."
|
||||
(interactive
|
||||
(list (read-regexp "Buffer pattern: ")
|
||||
(if current-prefix-arg
|
||||
(doom-project-buffer-list)
|
||||
(doom-buffer-list))
|
||||
t))
|
||||
(doom-kill-matching-buffers pattern buffer-list)
|
||||
(when interactive
|
||||
(message "Killed %d buffer(s)"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-buried-buffers (&optional buffer-list interactive)
|
||||
"Kill buffers that are buried.
|
||||
|
||||
If PROJECT-P (universal argument), only kill buried buffers belonging to the
|
||||
current project."
|
||||
(interactive
|
||||
(list (doom-buried-buffers
|
||||
(if current-prefix-arg (doom-project-buffer-list)))
|
||||
t))
|
||||
(mapc #'kill-buffer buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d buried buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/kill-project-buffers (project &optional interactive)
|
||||
"Kill buffers for the specified PROJECT."
|
||||
(interactive
|
||||
(list (if-let (open-projects (doom-open-projects))
|
||||
(completing-read
|
||||
"Kill buffers for project: " open-projects
|
||||
nil t nil nil
|
||||
(if-let* ((project-root (doom-project-root))
|
||||
(project-root (abbreviate-file-name project-root))
|
||||
((member project-root open-projects)))
|
||||
project-root))
|
||||
(message "No projects are open!")
|
||||
nil)
|
||||
t))
|
||||
(when project
|
||||
(let ((buffer-list (doom-project-buffer-list project)))
|
||||
(doom-kill-buffers-fixup-windows buffer-list)
|
||||
(doom--message-or-count
|
||||
interactive "Killed %d project buffers"
|
||||
(- (length buffer-list)
|
||||
(length (cl-remove-if-not #'buffer-live-p buffer-list)))))))
|
||||
126
lisp/lib/config.el
Normal file
126
lisp/lib/config.el
Normal file
|
|
@ -0,0 +1,126 @@
|
|||
;;; lisp/lib/config.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-bin-dir (expand-file-name "bin/" doom-emacs-dir))
|
||||
(defvar doom-bin (expand-file-name "doom" doom-bin-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-reloading-p nil
|
||||
"TODO")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/open-private-config ()
|
||||
"Browse your `doom-private-dir'."
|
||||
(interactive)
|
||||
(unless (file-directory-p doom-private-dir)
|
||||
(make-directory doom-private-dir t))
|
||||
(doom-project-browse doom-private-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/find-file-in-private-config ()
|
||||
"Search for a file in `doom-private-dir'."
|
||||
(interactive)
|
||||
(doom-project-find-file doom-private-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/goto-private-init-file ()
|
||||
"Open your private init.el file.
|
||||
And jumps to your `doom!' block."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "init.el" doom-private-dir))
|
||||
(goto-char
|
||||
(or (save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "(doom!" nil t))
|
||||
(point))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/goto-private-config-file ()
|
||||
"Open your private config.el file."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "config.el" doom-private-dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/goto-private-packages-file ()
|
||||
"Open your private packages.el file."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "packages.el" doom-private-dir)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Managements
|
||||
|
||||
(defmacro doom--if-compile (command on-success &optional on-failure)
|
||||
(declare (indent 2))
|
||||
`(let ((default-directory doom-emacs-dir))
|
||||
(with-current-buffer (compile ,command t)
|
||||
(let ((w (get-buffer-window (current-buffer))))
|
||||
(select-window w)
|
||||
(add-hook
|
||||
'compilation-finish-functions
|
||||
(lambda (_buf status)
|
||||
(if (equal status "finished\n")
|
||||
(progn
|
||||
(delete-window w)
|
||||
,on-success)
|
||||
,on-failure))
|
||||
nil 'local)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload ()
|
||||
"Reloads your private config.
|
||||
|
||||
This is experimental! It will try to do as `bin/doom sync' does, but from within
|
||||
this Emacs session. i.e. it reload autoloads files (if necessary), reloads your
|
||||
package list, and lastly, reloads your private config.el.
|
||||
|
||||
Runs `doom-after-reload-hook' afterwards."
|
||||
(interactive)
|
||||
(mapc #'require (cdr doom-incremental-packages))
|
||||
(doom--if-compile (format "%S sync -e" doom-bin)
|
||||
(let ((doom-reloading-p t))
|
||||
(doom-run-hooks 'doom-before-reload-hook)
|
||||
(load "doom-start")
|
||||
(with-demoted-errors "PRIVATE CONFIG ERROR: %s"
|
||||
(general-auto-unbind-keys)
|
||||
(unwind-protect
|
||||
(doom-initialize-modules 'force)
|
||||
(general-auto-unbind-keys t)))
|
||||
(doom-run-hooks 'doom-after-reload-hook)
|
||||
(message "Config successfully reloaded!"))
|
||||
(user-error "Failed to reload your config")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-autoloads ()
|
||||
"Reload only `doom-autoloads-file' and `doom-package-autoload-file'.
|
||||
|
||||
This is much faster and safer than `doom/reload', but not as comprehensive. This
|
||||
reloads your package and module visibility, but does not install new packages or
|
||||
remove orphaned ones. It also doesn't reload your private config.
|
||||
|
||||
It is useful to only pull in changes performed by 'doom sync' on the command
|
||||
line."
|
||||
(interactive)
|
||||
(load (file-name-sans-extension doom-autoloads-file) nil 'nomessage))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-env ()
|
||||
"Reloads your envvar file.
|
||||
|
||||
DOES NOT REGENERATE IT. You must run 'doom env' in your shell OUTSIDE of Emacs.
|
||||
Doing so from within Emacs will taint your shell environment.
|
||||
|
||||
An envvar file contains a snapshot of your shell environment, which can be
|
||||
imported into Emacs."
|
||||
(interactive)
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
(with-temp-buffer
|
||||
(doom-load-envvars-file doom-env-file)
|
||||
(message "Reloaded %S" (abbreviate-file-name doom-env-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/upgrade ()
|
||||
"Run 'doom upgrade' then prompt to restart Emacs."
|
||||
(interactive)
|
||||
(doom--if-compile (format "%S upgrade --force" doom-bin)
|
||||
(when (y-or-n-p "You must restart Emacs for the upgrade to take effect.\n\nRestart Emacs?")
|
||||
(doom/restart-and-restore))))
|
||||
408
lisp/lib/debug.el
Normal file
408
lisp/lib/debug.el
Normal file
|
|
@ -0,0 +1,408 @@
|
|||
;;; lisp/lib/debug.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Doom's debug mode
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-debug-variables
|
||||
'(async-debug
|
||||
debug-on-error
|
||||
(debugger . doom-debugger)
|
||||
(doom-print-level . debug)
|
||||
garbage-collection-messages
|
||||
gcmh-verbose
|
||||
init-file-debug
|
||||
jka-compr-verbose
|
||||
(message-log-max . 16384)
|
||||
url-debug
|
||||
use-package-verbose)
|
||||
"A list of variable to toggle on `doom-debug-mode'.
|
||||
|
||||
Each entry can be a variable symbol or a cons cell whose CAR is the variable
|
||||
symbol and CDR is the value to set it to when `doom-debug-mode' is activated.")
|
||||
|
||||
(defvar doom-debug--undefined-vars nil)
|
||||
|
||||
(defun doom-debug--watch-vars-h (&rest _)
|
||||
(when-let (bound-vars (cl-delete-if-not #'boundp doom-debug--undefined-vars))
|
||||
(doom-log "New variables available: %s" bound-vars)
|
||||
(let ((message-log-max nil))
|
||||
(doom-debug-mode -1)
|
||||
(doom-debug-mode +1))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode doom-debug-mode
|
||||
"Toggle `debug-on-error' and `init-file-debug' for verbose logging."
|
||||
:init-value init-file-debug
|
||||
:global t
|
||||
(let ((enabled doom-debug-mode))
|
||||
(setq doom-debug--undefined-vars nil)
|
||||
(dolist (var doom-debug-variables)
|
||||
(cond ((listp var)
|
||||
(pcase-let ((`(,var . ,val) var))
|
||||
(if (boundp var)
|
||||
(set-default
|
||||
var (if (not enabled)
|
||||
(prog1 (get var 'initial-value)
|
||||
(put 'x 'initial-value nil))
|
||||
(put var 'initial-value (symbol-value var))
|
||||
val))
|
||||
(add-to-list 'doom-debug--undefined-vars var))))
|
||||
((if (boundp var)
|
||||
(set-default var enabled)
|
||||
(add-to-list 'doom-debug--undefined-vars var)))))
|
||||
(when (called-interactively-p 'any)
|
||||
(when (fboundp 'explain-pause-mode)
|
||||
(explain-pause-mode (if enabled +1 -1))))
|
||||
;; Watch for changes in `doom-debug-variables', or when packages load (and
|
||||
;; potentially define one of `doom-debug-variables'), in case some of them
|
||||
;; aren't defined when `doom-debug-mode' is first loaded.
|
||||
(cond (enabled
|
||||
(message "Debug mode enabled! (Run 'M-x view-echo-area-messages' to open the log buffer)")
|
||||
;; Produce more helpful (and visible) error messages from errors
|
||||
;; emitted from hooks (particularly mode hooks), that usually go
|
||||
;; unnoticed otherwise.
|
||||
(advice-add #'run-hooks :override #'doom-run-hooks)
|
||||
;; Add time stamps to lines in *Messages*
|
||||
(advice-add #'message :before #'doom--timestamped-message-a)
|
||||
(add-variable-watcher 'doom-debug-variables #'doom-debug--watch-vars-h)
|
||||
(add-hook 'after-load-functions #'doom-debug--watch-vars-h))
|
||||
(t
|
||||
(advice-remove #'run-hooks #'doom-run-hooks)
|
||||
(advice-remove #'message #'doom--timestamped-message-a)
|
||||
(remove-variable-watcher 'doom-debug-variables #'doom-debug--watch-vars-h)
|
||||
(remove-hook 'after-load-functions #'doom-debug--watch-vars-h)
|
||||
(message "Debug mode disabled!")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom debuggers
|
||||
|
||||
(autoload 'backtrace-get-frames "backtrace")
|
||||
|
||||
(defun doom-backtrace ()
|
||||
"Return a stack trace as a list of `backtrace-frame' objects."
|
||||
;; (let* ((n 0)
|
||||
;; (frame (backtrace-frame n))
|
||||
;; (frame-list nil)
|
||||
;; (in-program-stack nil))
|
||||
;; (while frame
|
||||
;; (when in-program-stack
|
||||
;; (push (cdr frame) frame-list))
|
||||
;; (when (eq (elt frame 1) debugger)
|
||||
;; (setq in-program-stack t))
|
||||
;; ;; (when (and (eq (elt frame 1) 'doom-cli-execute)
|
||||
;; ;; (eq (elt frame 2) :doom))
|
||||
;; ;; (setq in-program-stack nil))
|
||||
;; (setq n (1+ n)
|
||||
;; frame (backtrace-frame n)))
|
||||
;; (nreverse frame-list))
|
||||
(cdr (backtrace-get-frames debugger)))
|
||||
|
||||
(defun doom-backtrace-write-to-file (backtrace file)
|
||||
"Write BACKTRACE to FILE with appropriate boilerplate."
|
||||
(make-directory (file-name-directory file) t)
|
||||
(let ((doom-print-indent 0))
|
||||
(with-temp-file file
|
||||
(insert ";; -*- lisp-interaction -*-\n")
|
||||
(insert ";; vim: set ft=lisp:\n")
|
||||
(insert (format ";; command=%S\n" command-line-args))
|
||||
(insert (format ";; date=%S\n\n" (format-time-string "%Y-%m-%d %H-%M-%S" before-init-time)))
|
||||
(insert ";;;; ENVIRONMENT\n" (with-output-to-string (doom/version)) "\n")
|
||||
(let ((standard-output (current-buffer))
|
||||
(print-quoted t)
|
||||
(print-escape-newlines t)
|
||||
(print-escape-control-characters t)
|
||||
(print-symbols-bare t)
|
||||
(print-level nil)
|
||||
(print-circle nil)
|
||||
(n -1))
|
||||
(mapc (lambda (frame)
|
||||
(princ (format ";;;; %d\n" (cl-incf n)))
|
||||
(pp (list (cons (backtrace-frame-fun frame)
|
||||
(backtrace-frame-args frame))
|
||||
(backtrace-frame-locals frame)))
|
||||
(terpri))
|
||||
backtrace))
|
||||
file)))
|
||||
|
||||
(defun doom-debugger (&rest args)
|
||||
"Enter `debugger' in interactive sessions, `doom-cli-debugger' otherwise.
|
||||
|
||||
Writes backtraces to file and ensures the backtrace is recorded, so the user can
|
||||
always access it."
|
||||
(let ((backtrace (doom-backtrace)))
|
||||
;; Work around Emacs's heuristic (in eval.c) for detecting errors in the
|
||||
;; debugger, which would run this handler again on subsequent calls. Taken
|
||||
;; from `ert--run-test-debugger'.
|
||||
(cl-incf num-nonmacro-input-events)
|
||||
;; TODO Write backtraces to file
|
||||
;; TODO Write backtrace to a buffer in case recursive error interupts the
|
||||
;; debugger (happens more often than it should).
|
||||
(apply #'debug args)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Time-stamped *Message* logs
|
||||
|
||||
(defun doom--timestamped-message-a (format-string &rest args)
|
||||
"Advice to run before `message' that prepends a timestamp to each message.
|
||||
|
||||
Activate this advice with:
|
||||
(advice-add 'message :before 'doom--timestamped-message-a)"
|
||||
(when (and (stringp format-string)
|
||||
message-log-max
|
||||
(not (string-equal format-string "%s%s")))
|
||||
(with-current-buffer "*Messages*"
|
||||
(let ((timestamp (format-time-string "[%F %T] " (current-time)))
|
||||
(deactivate-mark nil))
|
||||
(with-silent-modifications
|
||||
(goto-char (point-max))
|
||||
(if (not (bolp))
|
||||
(newline))
|
||||
(insert timestamp))))
|
||||
(let ((window (get-buffer-window "*Messages*")))
|
||||
(when (and window (not (equal (selected-window) window)))
|
||||
(with-current-buffer "*Messages*"
|
||||
(goto-char (point-max))
|
||||
(set-window-point window (point-max)))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-run-all-startup-hooks-h ()
|
||||
"Run all startup Emacs hooks. Meant to be executed after starting Emacs with
|
||||
-q or -Q, for example:
|
||||
|
||||
emacs -Q -l init.el -f doom-run-all-startup-hooks-h"
|
||||
(setq after-init-time (current-time))
|
||||
(let ((inhibit-startup-hooks nil))
|
||||
(doom-run-hooks 'after-init-hook
|
||||
'delayed-warnings-hook
|
||||
'emacs-startup-hook
|
||||
'tty-setup-hook
|
||||
'window-setup-hook)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defsubst doom--collect-forms-in (file form)
|
||||
(when (file-readable-p file)
|
||||
(let (forms)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(while (re-search-forward (format "(%s " (regexp-quote form)) nil t)
|
||||
(let ((ppss (syntax-ppss)))
|
||||
(unless (or (nth 4 ppss)
|
||||
(nth 3 ppss))
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(push (sexp-at-point) forms))))))
|
||||
(nreverse forms)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-info ()
|
||||
"Returns diagnostic information about the current Emacs session in markdown,
|
||||
ready to be pasted in a bug report on github."
|
||||
(require 'vc-git)
|
||||
(require 'doom-packages)
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
(letf! ((defun sh (&rest args) (cdr (apply #'doom-call-process args)))
|
||||
(defun cat (file &optional limit)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file nil 0 limit)
|
||||
(buffer-string)))
|
||||
(defun abbrev-path (path)
|
||||
(replace-regexp-in-string
|
||||
(regexp-opt (list (user-login-name)) 'words) "$USER"
|
||||
(abbreviate-file-name path)))
|
||||
(defun symlink-path (file)
|
||||
(format "%s%s" (abbrev-path file)
|
||||
(if (file-symlink-p file) ""
|
||||
(concat " -> " (abbrev-path (file-truename file)))))))
|
||||
`((generated . ,(format-time-string "%b %d, %Y %H:%M:%S"))
|
||||
(system . ,(delq
|
||||
nil (list (doom-system-distro-version)
|
||||
(when (executable-find "uname")
|
||||
(sh "uname" "-msr"))
|
||||
(window-system))))
|
||||
(emacs . ,(delq
|
||||
nil (list emacs-version
|
||||
(bound-and-true-p emacs-repository-branch)
|
||||
(and (stringp emacs-repository-version)
|
||||
(substring emacs-repository-version 0 9))
|
||||
(symlink-path doom-emacs-dir))))
|
||||
(doom . ,(list doom-version
|
||||
(sh "git" "log" "-1" "--format=%D %h %ci")
|
||||
(symlink-path doom-private-dir)))
|
||||
(shell . ,(abbrev-path shell-file-name))
|
||||
(features . ,system-configuration-features)
|
||||
(traits
|
||||
. ,(mapcar
|
||||
#'symbol-name
|
||||
(delq
|
||||
nil (list (cond (noninteractive 'batch)
|
||||
((display-graphic-p) 'gui)
|
||||
('tty))
|
||||
(if (daemonp) 'daemon)
|
||||
(if (and (require 'server)
|
||||
(server-running-p))
|
||||
'server-running)
|
||||
(if (boundp 'chemacs-version)
|
||||
(intern (format "chemacs-%s" chemacs-version)))
|
||||
(if (file-exists-p doom-env-file)
|
||||
'envvar-file)
|
||||
(if (featurep 'exec-path-from-shell)
|
||||
'exec-path-from-shell)
|
||||
(if (file-symlink-p doom-emacs-dir)
|
||||
'symlinked-emacsdir)
|
||||
(if (file-symlink-p doom-private-dir)
|
||||
'symlinked-doomdir)
|
||||
(if (and (stringp custom-file) (file-exists-p custom-file))
|
||||
'custom-file)
|
||||
(if (doom-files-in `(,@doom-modules-dirs
|
||||
,doom-core-dir
|
||||
,doom-private-dir)
|
||||
:type 'files :match "\\.elc$")
|
||||
'byte-compiled-config)))))
|
||||
(custom
|
||||
,@(when (and (stringp custom-file)
|
||||
(file-exists-p custom-file))
|
||||
(cl-loop for (type var _) in (get 'user 'theme-settings)
|
||||
if (eq type 'theme-value)
|
||||
collect var)))
|
||||
(modules
|
||||
,@(or (cl-loop with cat = nil
|
||||
for key being the hash-keys of doom-modules
|
||||
if (or (not cat)
|
||||
(not (eq cat (car key))))
|
||||
do (setq cat (car key))
|
||||
and collect cat
|
||||
collect
|
||||
(let* ((flags (doom-module-get cat (cdr key) :flags))
|
||||
(path (doom-module-get cat (cdr key) :path))
|
||||
(module
|
||||
(append
|
||||
(cond ((null path)
|
||||
(list '&nopath))
|
||||
((not (file-in-directory-p path doom-modules-dir))
|
||||
(list '&user)))
|
||||
(if flags
|
||||
`(,(cdr key) ,@flags)
|
||||
(list (cdr key))))))
|
||||
(if (= (length module) 1)
|
||||
(car module)
|
||||
module)))
|
||||
'("n/a")))
|
||||
(packages
|
||||
,@(condition-case e
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"package!"))
|
||||
(error (format "<%S>" e))))
|
||||
(unpin
|
||||
,@(condition-case e
|
||||
(mapcan #'identity
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"unpin!")))
|
||||
(error (list (format "<%S>" e)))))
|
||||
(elpa
|
||||
,@(condition-case e
|
||||
(progn
|
||||
(unless (bound-and-true-p package--initialized)
|
||||
(package-initialize))
|
||||
(cl-loop for (name . _) in package-alist
|
||||
collect (format "%s" name)))
|
||||
(error (format "<%S>" e))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-info-string (&optional width nocolor)
|
||||
"Return the `doom-info' as a compact string.
|
||||
|
||||
FILL-COLUMN determines the column at which lines will be broken."
|
||||
(with-temp-buffer
|
||||
(let ((doom-print-backend (unless nocolor doom-print-backend))
|
||||
(doom-print-indent 0))
|
||||
(dolist (spec (cl-remove-if-not #'cdr (doom-info)) (buffer-string))
|
||||
;; FIXME Refactor this horrible cludge, either here or in `format!'
|
||||
(insert! ((bold "%-10s ") (symbol-name (car spec)))
|
||||
("%s\n"
|
||||
(string-trim-left
|
||||
(indent
|
||||
(fill
|
||||
(if (listp (cdr spec))
|
||||
(mapconcat (doom-partial #'format "%s")
|
||||
(cdr spec)
|
||||
" ")
|
||||
(cdr spec))
|
||||
(- (or width 80) 11))
|
||||
11))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/version ()
|
||||
"Display the running version of Doom core, module sources, and Emacs."
|
||||
(interactive)
|
||||
(print! "%s\n%s\n%s"
|
||||
(format "%-13s v%-15s %s"
|
||||
"GNU Emacs"
|
||||
emacs-version
|
||||
emacs-repository-version)
|
||||
(format "%-13s v%-15s %s"
|
||||
"Doom core"
|
||||
doom-version
|
||||
(or (cdr (doom-call-process
|
||||
"git" "-C" doom-emacs-dir
|
||||
"log" "-1" "--format=%D %h %ci"))
|
||||
"n/a"))
|
||||
;; NOTE This is a placeholder. Our modules will be moved to its own
|
||||
;; repo eventually, and Doom core will later be capable of managing
|
||||
;; them like package sources.
|
||||
(format "%-13s v%-15s %s"
|
||||
"Doom modules"
|
||||
doom-modules-version
|
||||
(or (cdr (doom-call-process
|
||||
"git" "-C" doom-modules-dir
|
||||
"log" "-1" "--format=%D %h %ci"))
|
||||
"n/a"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/info ()
|
||||
"Collects some debug information about your Emacs session, formats it and
|
||||
copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
(interactive)
|
||||
(let ((buffer (get-buffer-create "*doom info*")))
|
||||
(with-current-buffer buffer
|
||||
(setq buffer-read-only t)
|
||||
(with-silent-modifications
|
||||
(erase-buffer)
|
||||
(insert (doom-info-string 86)))
|
||||
(pop-to-buffer buffer)
|
||||
(kill-new (buffer-string))
|
||||
(when (y-or-n-p "Your doom-info was copied to the clipboard.\n\nOpen pastebin.com?")
|
||||
(browse-url "https://pastebin.com")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Profiling
|
||||
|
||||
(defvar doom--profiler nil)
|
||||
;;;###autoload
|
||||
(defun doom/toggle-profiler ()
|
||||
"Toggle the Emacs profiler. Run it again to see the profiling report."
|
||||
(interactive)
|
||||
(if (not doom--profiler)
|
||||
(profiler-start 'cpu+mem)
|
||||
(profiler-report)
|
||||
(profiler-stop))
|
||||
(setq doom--profiler (not doom--profiler)))
|
||||
350
lisp/lib/files.el
Normal file
350
lisp/lib/files.el
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
;;; lisp/lib/files.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defun doom--resolve-path-forms (spec &optional directory)
|
||||
"Converts a simple nested series of or/and forms into a series of
|
||||
`file-exists-p' checks.
|
||||
|
||||
For example
|
||||
|
||||
(doom--resolve-path-forms
|
||||
'(or A (and B C))
|
||||
\"~\")
|
||||
|
||||
Returns (approximately):
|
||||
|
||||
'(let* ((_directory \"~\")
|
||||
(A (expand-file-name A _directory))
|
||||
(B (expand-file-name B _directory))
|
||||
(C (expand-file-name C _directory)))
|
||||
(or (and (file-exists-p A) A)
|
||||
(and (if (file-exists-p B) B)
|
||||
(if (file-exists-p C) C))))
|
||||
|
||||
This is used by `file-exists-p!' and `project-file-exists-p!'."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (and (listp spec)
|
||||
(memq (car spec) '(or and)))
|
||||
(cons (car spec)
|
||||
(mapcar (doom-rpartial #'doom--resolve-path-forms directory)
|
||||
(cdr spec)))
|
||||
(let ((filevar (make-symbol "file")))
|
||||
`(let ((,filevar ,spec))
|
||||
(and (stringp ,filevar)
|
||||
,(if directory
|
||||
`(let ((default-directory ,directory))
|
||||
(file-exists-p ,filevar))
|
||||
`(file-exists-p ,filevar))
|
||||
,filevar)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-path (&rest segments)
|
||||
"Constructs a file path from SEGMENTS.
|
||||
Ignores `nil' elements in SEGMENTS."
|
||||
(let ((segments (remq nil segments))
|
||||
file-name-handler-alist
|
||||
dir)
|
||||
(while segments
|
||||
(setq segment (pop segments)
|
||||
dir (expand-file-name
|
||||
(if (listp segment)
|
||||
(apply #'doom-path dir segment)
|
||||
segment)
|
||||
dir)))
|
||||
dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-glob (&rest segments)
|
||||
"Construct a path from SEGMENTS and expand glob patterns.
|
||||
Returns nil if the path doesn't exist.
|
||||
Ignores `nil' elements in SEGMENTS."
|
||||
(let (case-fold-search)
|
||||
(file-expand-wildcards (apply #'doom-path segments) t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-dir (&rest segments)
|
||||
"Constructs a path from SEGMENTS.
|
||||
See `doom-path'.
|
||||
Ignores `nil' elements in SEGMENTS."
|
||||
(when-let (path (doom-path segments))
|
||||
(directory-file-name path)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun doom-files-in
|
||||
(paths &rest rest
|
||||
&key
|
||||
filter
|
||||
map
|
||||
(full t)
|
||||
(follow-symlinks t)
|
||||
(type 'files)
|
||||
(relative-to (unless full default-directory))
|
||||
(depth 99999)
|
||||
(mindepth 0)
|
||||
(match "/[^._][^/]+"))
|
||||
"Return a list of files/directories in PATHS (one string or a list of them).
|
||||
|
||||
FILTER is a function or symbol that takes one argument (the path). If it returns
|
||||
non-nil, the entry will be excluded.
|
||||
|
||||
MAP is a function or symbol which will be used to transform each entry in the
|
||||
results.
|
||||
|
||||
TYPE determines what kind of path will be included in the results. This can be t
|
||||
(files and folders), 'files or 'dirs.
|
||||
|
||||
By default, this function returns paths relative to PATH-OR-PATHS if it is a
|
||||
single path. If it a list of paths, this function returns absolute paths.
|
||||
Otherwise, by setting RELATIVE-TO to a path, the results will be transformed to
|
||||
be relative to it.
|
||||
|
||||
The search recurses up to DEPTH and no further. DEPTH is an integer.
|
||||
|
||||
MATCH is a string regexp. Only entries that match it will be included."
|
||||
(let (result)
|
||||
(dolist (file (mapcan (doom-rpartial #'doom-glob "*") (doom-enlist paths)))
|
||||
(cond ((file-directory-p file)
|
||||
(appendq!
|
||||
result
|
||||
(and (memq type '(t dirs))
|
||||
(string-match-p match file)
|
||||
(not (and filter (funcall filter file)))
|
||||
(not (and (file-symlink-p file)
|
||||
(not follow-symlinks)))
|
||||
(<= mindepth 0)
|
||||
(list (if relative-to
|
||||
(file-relative-name file relative-to)
|
||||
file)))
|
||||
(and (>= depth 1)
|
||||
(apply #'doom-files-in file
|
||||
(append (list :mindepth (1- mindepth)
|
||||
:depth (1- depth)
|
||||
:relative-to relative-to
|
||||
:map nil)
|
||||
rest)))))
|
||||
((and (memq type '(t files))
|
||||
(string-match-p match file)
|
||||
(not (and filter (funcall filter file)))
|
||||
(<= mindepth 0))
|
||||
(push (if relative-to
|
||||
(file-relative-name file relative-to)
|
||||
file)
|
||||
result))))
|
||||
(if map
|
||||
(mapcar map result)
|
||||
result)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-file-cookie-p (file &optional cookie null-value)
|
||||
"Returns the evaluated result of FORM in a ;;;###COOKIE FORM at the top of
|
||||
FILE.
|
||||
|
||||
If COOKIE doesn't exist, or cookie isn't within the first 256 bytes of FILE,
|
||||
return NULL-VALUE."
|
||||
(unless (file-exists-p file)
|
||||
(signal 'file-missing file))
|
||||
(unless (file-readable-p file)
|
||||
(error "%S is unreadable" file))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file nil 0 256)
|
||||
(if (re-search-forward (format "^;;;###%s " (regexp-quote (or cookie "if")))
|
||||
nil t)
|
||||
(let ((load-file-name file))
|
||||
(eval (sexp-at-point) t))
|
||||
null-value)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro file-exists-p! (files &optional directory)
|
||||
"Returns non-nil if the FILES in DIRECTORY all exist.
|
||||
|
||||
DIRECTORY is a path; defaults to `default-directory'.
|
||||
|
||||
Returns the last file found to meet the rules set by FILES, which can be a
|
||||
single file or nested compound statement of `and' and `or' statements."
|
||||
`(let ((p ,(doom--resolve-path-forms files directory)))
|
||||
(and p (expand-file-name p ,directory))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-file-size (file &optional dir)
|
||||
"Returns the size of FILE (in DIR) in bytes."
|
||||
(let ((file (expand-file-name file dir)))
|
||||
(unless (file-exists-p file)
|
||||
(error "Couldn't find file %S" file))
|
||||
(unless (file-readable-p file)
|
||||
(error "File %S is unreadable; can't acquire its filesize"
|
||||
file))
|
||||
(nth 7 (file-attributes file))))
|
||||
|
||||
(defvar w32-get-true-file-attributes)
|
||||
;;;###autoload
|
||||
(defun doom-directory-size (dir)
|
||||
"Returns the size of FILE (in DIR) in kilobytes."
|
||||
(unless (file-directory-p dir)
|
||||
(error "Directory %S does not exist" dir))
|
||||
(if (executable-find "du")
|
||||
(/ (string-to-number (cdr (doom-call-process "du" "-sb" dir)))
|
||||
1024.0)
|
||||
;; REVIEW This is slow and terribly inaccurate, but it's something
|
||||
(let ((w32-get-true-file-attributes t)
|
||||
(file-name-handler-alist dir)
|
||||
(max-lisp-eval-depth 5000)
|
||||
(sum 0.0))
|
||||
(dolist (attrs (directory-files-and-attributes dir nil nil t) sum)
|
||||
(unless (member (car attrs) '("." ".."))
|
||||
(cl-incf
|
||||
sum (if (eq (nth 1 attrs) t) ; is directory
|
||||
(doom-directory-size (expand-file-name (car attrs) dir))
|
||||
(/ (nth 8 attrs) 1024.0))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom--update-files (&rest files)
|
||||
"Ensure FILES are updated in `recentf', `magit' and `save-place'."
|
||||
(let (toplevels)
|
||||
(dolist (file files)
|
||||
(when (featurep 'vc)
|
||||
(vc-file-clearprops file)
|
||||
(when-let (buffer (get-file-buffer file))
|
||||
(with-current-buffer buffer
|
||||
(vc-refresh-state))))
|
||||
(when (featurep 'magit)
|
||||
(when-let (default-directory (magit-toplevel (file-name-directory file)))
|
||||
(cl-pushnew default-directory toplevels)))
|
||||
(unless (file-readable-p file)
|
||||
(when (bound-and-true-p recentf-mode)
|
||||
(recentf-remove-if-non-kept file))
|
||||
(when (and (bound-and-true-p projectile-mode)
|
||||
(doom-project-p)
|
||||
(projectile-file-cached-p file (doom-project-root)))
|
||||
(projectile-purge-file-from-cache file))))
|
||||
(dolist (default-directory toplevels)
|
||||
(magit-refresh))
|
||||
(when (bound-and-true-p save-place-mode)
|
||||
(save-place-forget-unreadable-files))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-this-file (&optional path force-p)
|
||||
"Delete PATH, kill its buffers and expunge it from vc/magit cache.
|
||||
|
||||
If PATH is not specified, default to the current buffer's file.
|
||||
|
||||
If FORCE-P, delete without confirmation."
|
||||
(interactive
|
||||
(list (buffer-file-name (buffer-base-buffer))
|
||||
current-prefix-arg))
|
||||
(let* ((path (or path (buffer-file-name (buffer-base-buffer))))
|
||||
(short-path (abbreviate-file-name path)))
|
||||
(unless (and path (file-exists-p path))
|
||||
(user-error "Buffer is not visiting any file"))
|
||||
(unless (file-exists-p path)
|
||||
(error "File doesn't exist: %s" path))
|
||||
(unless (or force-p (y-or-n-p (format "Really delete %S?" short-path)))
|
||||
(user-error "Aborted"))
|
||||
(let ((buf (current-buffer)))
|
||||
(unwind-protect
|
||||
(progn (delete-file path t) t)
|
||||
(if (file-exists-p path)
|
||||
(error "Failed to delete %S" short-path)
|
||||
;; Ensures that windows displaying this buffer will be switched to
|
||||
;; real buffers (`doom-real-buffer-p')
|
||||
(doom/kill-this-buffer-in-all-windows buf t)
|
||||
(doom--update-files path)
|
||||
(message "Deleted %S" short-path))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/copy-this-file (new-path &optional force-p)
|
||||
"Copy current buffer's file to NEW-PATH.
|
||||
|
||||
If FORCE-P, overwrite the destination file if it exists, without confirmation."
|
||||
(interactive
|
||||
(list (read-file-name "Copy file to: ")
|
||||
current-prefix-arg))
|
||||
(unless (and buffer-file-name (file-exists-p buffer-file-name))
|
||||
(user-error "Buffer is not visiting any file"))
|
||||
(let ((old-path (buffer-file-name (buffer-base-buffer)))
|
||||
(new-path (expand-file-name new-path)))
|
||||
(make-directory (file-name-directory new-path) 't)
|
||||
(copy-file old-path new-path (or force-p 1))
|
||||
(doom--update-files old-path new-path)
|
||||
(message "File copied to %S" (abbreviate-file-name new-path))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/move-this-file (new-path &optional force-p)
|
||||
"Move current buffer's file to NEW-PATH.
|
||||
|
||||
If FORCE-P, overwrite the destination file if it exists, without confirmation."
|
||||
(interactive
|
||||
(list (read-file-name "Move file to: ")
|
||||
current-prefix-arg))
|
||||
(unless (and buffer-file-name (file-exists-p buffer-file-name))
|
||||
(user-error "Buffer is not visiting any file"))
|
||||
(let ((old-path (buffer-file-name (buffer-base-buffer)))
|
||||
(new-path (expand-file-name new-path)))
|
||||
(when (directory-name-p new-path)
|
||||
(setq new-path (concat new-path (file-name-nondirectory old-path))))
|
||||
(make-directory (file-name-directory new-path) 't)
|
||||
(rename-file old-path new-path (or force-p 1))
|
||||
(set-visited-file-name new-path t t)
|
||||
(doom--update-files old-path new-path)
|
||||
(message "File moved to %S" (abbreviate-file-name new-path))))
|
||||
|
||||
(defun doom--sudo-file-path (file)
|
||||
(let ((host (or (file-remote-p file 'host) "localhost")))
|
||||
(concat "/" (when (file-remote-p file)
|
||||
(concat (file-remote-p file 'method) ":"
|
||||
(if-let (user (file-remote-p file 'user))
|
||||
(concat user "@" host)
|
||||
host)
|
||||
"|"))
|
||||
"sudo:root@" host
|
||||
":" (or (file-remote-p file 'localname)
|
||||
file))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sudo-find-file (file)
|
||||
"Open FILE as root."
|
||||
(interactive "FOpen file as root: ")
|
||||
(find-file (doom--sudo-file-path file)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sudo-this-file ()
|
||||
"Open the current file as root."
|
||||
(interactive)
|
||||
(find-file
|
||||
(doom--sudo-file-path
|
||||
(or buffer-file-name
|
||||
(when (or (derived-mode-p 'dired-mode)
|
||||
(derived-mode-p 'wdired-mode))
|
||||
default-directory)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sudo-save-buffer ()
|
||||
"Save this file as root."
|
||||
(interactive)
|
||||
(let ((file (doom--sudo-file-path buffer-file-name)))
|
||||
(if-let (buffer (find-file-noselect file))
|
||||
(let ((origin (current-buffer)))
|
||||
(copy-to-buffer buffer (point-min) (point-max))
|
||||
(unwind-protect
|
||||
(with-current-buffer buffer
|
||||
(save-buffer))
|
||||
(unless (eq origin buffer)
|
||||
(kill-buffer buffer))
|
||||
(with-current-buffer origin
|
||||
(revert-buffer t t))))
|
||||
(user-error "Unable to open %S" file))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/remove-recent-file (file)
|
||||
"Remove FILE from your recently-opened-files list."
|
||||
(interactive
|
||||
(list (completing-read "Remove recent file: " recentf-list
|
||||
nil t)))
|
||||
(setq recentf-list (delete file recentf-list))
|
||||
(recentf-save-list)
|
||||
(message "Removed %S from `recentf-list'" (abbreviate-file-name file)))
|
||||
180
lisp/lib/fonts.el
Normal file
180
lisp/lib/fonts.el
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
;;; lisp/lib/fonts.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-font-increment 2
|
||||
"How many steps to increase the font size each time `doom/increase-font-size'
|
||||
or `doom/decrease-font-size' are invoked.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-big-font nil
|
||||
"The font to use for `doom-big-font-mode'.
|
||||
If nil, `doom-font' will be used, scaled up by `doom-big-font-increment'. See
|
||||
`doom-font' for details on acceptable values for this variable.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-big-font-increment 4
|
||||
"How many steps to increase the font size (with `doom-font' as the base) when
|
||||
`doom-big-font-mode' is enabled and `doom-big-font' is nil.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-normalize-font (font)
|
||||
"Return FONT as a normalized font spec.
|
||||
|
||||
The font will be normalized (i.e. :weight, :slant, and :width will set to
|
||||
'normal if not specified) before it is converted.
|
||||
|
||||
FONT can be a `font-spec', a font object, an XFT font string, or an XLFD font
|
||||
string."
|
||||
(cl-check-type font (or font string vector))
|
||||
(when (and (stringp font)
|
||||
(string-prefix-p "-" font))
|
||||
(setq font (x-decompose-font-name font)))
|
||||
(let* ((font
|
||||
(cond ((stringp font)
|
||||
(dolist (prop '("weight" "slant" "width") (aref (font-info font) 0))
|
||||
(unless (string-match-p (format ":%s=" prop) font)
|
||||
(setq font (concat font ":" prop "=normal")))))
|
||||
((fontp font)
|
||||
(dolist (prop '(:weight :slant :width) (font-xlfd-name font))
|
||||
(unless (font-get font prop)
|
||||
(font-put font prop 'normal))))
|
||||
((vectorp font)
|
||||
(dolist (i '(1 2 3) (x-compose-font-name font))
|
||||
(unless (aref font i)
|
||||
(aset font i "normal"))))))
|
||||
(font (x-resolve-font-name font))
|
||||
(font (font-spec :name font)))
|
||||
(unless (font-get font :size)
|
||||
(font-put font :size
|
||||
(font-get (font-spec :name (face-font 'default))
|
||||
:size)))
|
||||
font))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-adjust-font-size (increment &optional fixed-size-p font-alist)
|
||||
"Increase size of font in FRAME by INCREMENT.
|
||||
|
||||
If FIXED-SIZE-P is non-nil, treat INCREMENT as a font size, rather than a
|
||||
scaling factor.
|
||||
|
||||
FONT-ALIST is an alist give temporary values to certain Doom font variables,
|
||||
like `doom-font' or `doom-variable-pitch-font'. e.g.
|
||||
|
||||
`((doom-font . ,(font-spec :family \"Sans Serif\" :size 12)))
|
||||
|
||||
Doesn't work in terminal Emacs."
|
||||
(unless (display-multi-font-p)
|
||||
(user-error "Cannot resize fonts in terminal Emacs"))
|
||||
(condition-case-unless-debug e
|
||||
(let (changed)
|
||||
(dolist (sym '((doom-font . default)
|
||||
(doom-serif-font . fixed-pitch-serif)
|
||||
(doom-variable-pitch-font . variable-pitch))
|
||||
(when changed
|
||||
(doom-init-fonts-h 'reload)
|
||||
t))
|
||||
(cl-destructuring-bind (var . face) sym
|
||||
(if (null increment)
|
||||
(when (get var 'initial-value)
|
||||
(set var (get var 'initial-value))
|
||||
(put var 'initial-value nil)
|
||||
(setq changed t))
|
||||
(let* ((original-font (or (symbol-value var)
|
||||
(face-font face t)
|
||||
(with-temp-buffer (face-font face))))
|
||||
(font (doom-normalize-font original-font))
|
||||
(dfont
|
||||
(or (if-let* ((remap-font (alist-get var font-alist))
|
||||
(remap-xlfd (doom-normalize-font remap-font)))
|
||||
remap-xlfd
|
||||
(purecopy font))
|
||||
(error "Could not decompose %s font" var))))
|
||||
(let* ((step (if fixed-size-p 0 (* increment doom-font-increment)))
|
||||
(orig-size (font-get font :size))
|
||||
(new-size (if fixed-size-p increment (+ orig-size step))))
|
||||
(cond ((<= new-size 0)
|
||||
(error "`%s' font is too small to be resized (%d)" var new-size))
|
||||
((= orig-size new-size)
|
||||
(user-error "Could not resize `%s' for some reason" var))
|
||||
((setq changed t)
|
||||
(unless (get var 'initial-value)
|
||||
(put var 'initial-value original-font))
|
||||
(font-put dfont :size new-size)
|
||||
(set var dfont)))))))))
|
||||
(error
|
||||
(ignore-errors (doom-adjust-font-size nil))
|
||||
(signal (car e) (cdr e)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-font-exists-p (font)
|
||||
"Return non-nil if FONT exists on this system."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(ignore-errors (find-font (doom-normalize-font font))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-font ()
|
||||
"Reload your fonts, if they're set.
|
||||
See `doom-init-fonts-h'."
|
||||
(interactive)
|
||||
(doom-init-fonts-h 'reload))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/increase-font-size (count &optional increment)
|
||||
"Enlargens the font size across the current and child frames."
|
||||
(interactive "p")
|
||||
(doom-adjust-font-size (* count (or increment doom-font-increment))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/decrease-font-size (count &optional increment)
|
||||
"Shrinks the font size across the current and child frames."
|
||||
(interactive "p")
|
||||
(doom-adjust-font-size (* (- count) (or increment doom-font-increment))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reset-font-size ()
|
||||
"Reset font size and `text-scale'.
|
||||
|
||||
Assuming it has been adjusted via `doom/increase-font-size' and
|
||||
`doom/decrease-font-size', or `text-scale-*' commands."
|
||||
(interactive)
|
||||
(let (success)
|
||||
(when (and (boundp 'text-scale-mode-amount)
|
||||
(/= text-scale-mode-amount 0))
|
||||
(text-scale-set 0)
|
||||
(setq success t))
|
||||
(cond (doom-big-font-mode
|
||||
(message "Disabling `doom-big-font-mode'")
|
||||
(doom-big-font-mode -1)
|
||||
(setq success t))
|
||||
((doom-adjust-font-size nil)
|
||||
(setq success t)))
|
||||
(unless success
|
||||
(user-error "The font hasn't been resized"))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode doom-big-font-mode
|
||||
"Globally resizes your fonts for streams, screen-sharing or presentations.
|
||||
|
||||
Uses `doom-big-font' if its set, otherwise uses `doom-font' (falling back to
|
||||
your system font).
|
||||
|
||||
Also resizees `doom-variable-pitch-font' and `doom-serif-font'."
|
||||
:init-value nil
|
||||
:lighter " BIG"
|
||||
:global t
|
||||
(if doom-big-font
|
||||
;; Use `doom-big-font' in lieu of `doom-font'
|
||||
(doom-adjust-font-size
|
||||
(when doom-big-font-mode
|
||||
(font-get (doom-normalize-font doom-big-font) :size))
|
||||
t `((doom-font . ,doom-big-font)))
|
||||
;; Resize the current font
|
||||
(doom-adjust-font-size (if doom-big-font-mode doom-big-font-increment))))
|
||||
752
lisp/lib/help.el
Normal file
752
lisp/lib/help.el
Normal file
|
|
@ -0,0 +1,752 @@
|
|||
;;; lisp/lib/help.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom--help-major-mode-module-alist
|
||||
'((dockerfile-mode :tools docker)
|
||||
(agda2-mode :lang agda)
|
||||
(c-mode :lang cc)
|
||||
(c++-mode :lang cc)
|
||||
(objc++-mode :lang cc)
|
||||
(crystal-mode :lang crystal)
|
||||
(lisp-mode :lang common-lisp)
|
||||
(csharp-mode :lang csharp)
|
||||
(clojure-mode :lang clojure)
|
||||
(clojurescript-mode :lang clojure)
|
||||
(json-mode :lang json)
|
||||
(yaml-mode :lang yaml)
|
||||
(csv-mode :lang data)
|
||||
(erlang-mode :lang erlang)
|
||||
(elixir-mode :lang elixir)
|
||||
(elm-mode :lang elm)
|
||||
(emacs-lisp-mode :lang emacs-lisp)
|
||||
(ess-r-mode :lang ess)
|
||||
(ess-julia-mode :lang ess)
|
||||
(go-mode :lang go)
|
||||
(haskell-mode :lang haskell)
|
||||
(hy-mode :lang hy)
|
||||
(idris-mode :lang idris)
|
||||
(java-mode :lang java)
|
||||
(js2-mode :lang javascript)
|
||||
(rjsx-mode :lang javascript)
|
||||
(typescript-mode :lang javascript)
|
||||
(typescript-tsx-mode :lang javascript)
|
||||
(coffee-mode :lang javascript)
|
||||
(julia-mode :lang julia)
|
||||
(kotlin-mode :lang kotlin)
|
||||
(latex-mode :lang latex)
|
||||
(LaTeX-mode :lang latex)
|
||||
(ledger-mode :lang ledger)
|
||||
(lua-mode :lang lua)
|
||||
(moonscript-mode :lang lua)
|
||||
(markdown-mode :lang markdown)
|
||||
(gfm-mode :lang markdown)
|
||||
(nim-mode :lang nim)
|
||||
(nix-mode :lang nix)
|
||||
(tuareg-mode :lang ocaml)
|
||||
(org-mode :lang org)
|
||||
(raku-mode :lang raku)
|
||||
(php-mode :lang php)
|
||||
(hack-mode :lang php)
|
||||
(plantuml-mode :lang plantuml)
|
||||
(purescript-mode :lang purescript)
|
||||
(python-mode :lang python)
|
||||
(restclient-mode :lang rest)
|
||||
(ruby-mode :lang ruby)
|
||||
(rust-mode :lang rust)
|
||||
(rustic-mode :lang rust)
|
||||
(scala-mode :lang scala)
|
||||
(scheme-mode :lang scheme)
|
||||
(sh-mode :lang sh)
|
||||
(swift-mode :lang swift)
|
||||
(web-mode :lang web)
|
||||
(css-mode :lang web)
|
||||
(scss-mode :lang web)
|
||||
(sass-mode :lang web)
|
||||
(less-css-mode :lang web)
|
||||
(stylus-mode :lang web)
|
||||
(terra-mode :lang terra))
|
||||
"An alist mapping major modes to Doom modules.
|
||||
|
||||
This is used by `doom/help-modules' to auto-select the module corresponding to
|
||||
the current major-modea.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-active-minor-modes ()
|
||||
"Return a list of active minor-mode symbols."
|
||||
(cl-loop for mode in minor-mode-list
|
||||
if (and (boundp mode) (symbol-value mode))
|
||||
collect mode))
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom describe commands
|
||||
|
||||
;;;###autoload (defalias 'doom/describe-autodefs #'doom/help-autodefs)
|
||||
;;;###autoload (defalias 'doom/describe-module #'doom/help-modules)
|
||||
;;;###autoload (defalias 'doom/describe-package #'doom/help-packages)
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/describe-active-minor-mode (mode)
|
||||
"Get information on an active minor mode. Use `describe-minor-mode' for a
|
||||
selection of all minor-modes, active or not."
|
||||
(interactive
|
||||
(list (completing-read "Describe active mode: " (doom-active-minor-modes))))
|
||||
(let ((symbol
|
||||
(cond ((stringp mode) (intern mode))
|
||||
((symbolp mode) mode)
|
||||
((error "Expected a symbol/string, got a %s" (type-of mode))))))
|
||||
(if (fboundp symbol)
|
||||
(helpful-function symbol)
|
||||
(helpful-variable symbol))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Documentation commands
|
||||
|
||||
(defvar org-agenda-files)
|
||||
(cl-defun doom--org-headings (files &key depth mindepth include-files &allow-other-keys)
|
||||
"TODO"
|
||||
(require 'org)
|
||||
(let* ((default-directory doom-docs-dir)
|
||||
(org-agenda-files (mapcar #'expand-file-name (doom-enlist files)))
|
||||
(depth (if (integerp depth) depth))
|
||||
(mindepth (if (integerp mindepth) mindepth))
|
||||
(org-inhibit-startup t))
|
||||
(message "Loading search results...")
|
||||
(unwind-protect
|
||||
(delq
|
||||
nil
|
||||
(org-map-entries
|
||||
(lambda ()
|
||||
(cl-destructuring-bind (level _reduced-level _todo _priority text tags)
|
||||
(org-heading-components)
|
||||
(when (and (or (null depth)
|
||||
(<= level depth))
|
||||
(or (null mindepth)
|
||||
(>= level mindepth))
|
||||
(or (null tags)
|
||||
(not (string-match-p ":TOC" tags))))
|
||||
(let ((path (org-get-outline-path))
|
||||
(title (org-collect-keywords '("TITLE") '("TITLE"))))
|
||||
(list (string-join
|
||||
(list (string-join
|
||||
(append (when include-files
|
||||
(list (or (cdr (assoc "TITLE" title))
|
||||
(file-relative-name (buffer-file-name)))))
|
||||
path
|
||||
(when text
|
||||
(list (replace-regexp-in-string org-link-any-re "\\4" text))))
|
||||
" > ")
|
||||
tags)
|
||||
" ")
|
||||
(buffer-file-name)
|
||||
(point))))))
|
||||
t 'agenda))
|
||||
(mapc #'kill-buffer org-agenda-new-buffers)
|
||||
(setq org-agenda-new-buffers nil))))
|
||||
|
||||
(defvar ivy-sort-functions-alist)
|
||||
;;;###autoload
|
||||
(cl-defun doom-completing-read-org-headings
|
||||
(prompt files &rest plist &key depth mindepth include-files initial-input extra-candidates action)
|
||||
"TODO"
|
||||
(let ((alist
|
||||
(append (apply #'doom--org-headings files plist)
|
||||
extra-candidates))
|
||||
ivy-sort-functions-alist)
|
||||
(if-let (result (completing-read prompt alist nil nil initial-input))
|
||||
(cl-destructuring-bind (file &optional location)
|
||||
(cdr (assoc result alist))
|
||||
(if action
|
||||
(funcall action file location)
|
||||
(find-file file)
|
||||
(cond ((functionp location)
|
||||
(funcall location))
|
||||
(location
|
||||
(goto-char location)))
|
||||
(ignore-errors
|
||||
(when (outline-invisible-p)
|
||||
(save-excursion
|
||||
(outline-previous-visible-heading 1)
|
||||
(org-show-subtree))))))
|
||||
(user-error "Aborted"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/homepage ()
|
||||
"Open the doom emacs homepage in the browser."
|
||||
(interactive)
|
||||
(browse-url "https://doomemacs.org"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/issue-tracker ()
|
||||
"Open Doom Emacs' issue tracker on Discourse."
|
||||
(interactive)
|
||||
(browse-url "https://github.com/hlissner/doom-emacs/issues"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/report-bug ()
|
||||
"Open the browser on our Discourse.
|
||||
|
||||
If called when a backtrace buffer is present, it and the output of `doom-info'
|
||||
will be automatically appended to the result."
|
||||
(interactive)
|
||||
;; TODO Upload doom/info to pastebin and append to querystring
|
||||
(browse-url "https://github.com/hlissner/doom-emacs/issues/new?labels=1.+bug%2C2.+status%3Aunread&template=bug_report.yml"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/discourse ()
|
||||
"Open Doom Emacs' issue tracker on Discourse."
|
||||
(interactive)
|
||||
(browse-url "https://discourse.doomemacs.org"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help ()
|
||||
"Open Doom's user manual."
|
||||
(interactive)
|
||||
(find-file (expand-file-name "index.org" doom-docs-dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-headings (&optional initial-input)
|
||||
"Search Doom's documentation and jump to a headline."
|
||||
(interactive)
|
||||
(doom-completing-read-org-headings
|
||||
"Find in Doom help: "
|
||||
(list "getting_started.org"
|
||||
"contributing.org"
|
||||
"troubleshooting.org"
|
||||
"tutorials.org"
|
||||
"faq.org")
|
||||
:depth 3
|
||||
:include-files t
|
||||
:initial-input initial-input
|
||||
:extra-candidates
|
||||
(mapcar (lambda (x)
|
||||
(setcar x (concat "Doom Modules > " (car x)))
|
||||
x)
|
||||
(doom--help-modules-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search (&optional initial-input)
|
||||
"Perform a text search on all of Doom's documentation."
|
||||
(interactive)
|
||||
(funcall (cond ((fboundp '+ivy-file-search)
|
||||
#'+ivy-file-search)
|
||||
((fboundp '+helm-file-search)
|
||||
#'+helm-file-search)
|
||||
((fboundp '+vertico-file-search)
|
||||
#'+vertico-file-search)
|
||||
((rgrep
|
||||
(read-regexp
|
||||
"Search for" (or initial-input 'grep-tag-default)
|
||||
'grep-regexp-history)
|
||||
"*.org" doom-emacs-dir)
|
||||
#'ignore))
|
||||
:query initial-input
|
||||
:args '("-t" "org")
|
||||
:in doom-emacs-dir
|
||||
:prompt "Search documentation for: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-news (&optional initial-input)
|
||||
"Search headlines in Doom's newsletters."
|
||||
(interactive)
|
||||
(doom-completing-read-org-headings
|
||||
"Find in News: "
|
||||
(nreverse (doom-files-in (expand-file-name "news" doom-docs-dir)
|
||||
:match "/[0-9]"
|
||||
:relative-to doom-docs-dir))
|
||||
:include-files t
|
||||
:initial-input initial-input))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-faq (&optional initial-input)
|
||||
"Search Doom's FAQ and jump to a question."
|
||||
(interactive)
|
||||
(doom-completing-read-org-headings
|
||||
"Find in FAQ: " (list "faq.org")
|
||||
:depth 2
|
||||
:initial-input initial-input))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-news ()
|
||||
"Open a Doom newsletter.
|
||||
The latest newsletter will be selected by default."
|
||||
(interactive)
|
||||
(let* ((default-directory (expand-file-name "news/" doom-docs-dir))
|
||||
(news-files (doom-files-in default-directory)))
|
||||
(find-file
|
||||
(read-file-name (format "Open Doom newsletter (current: v%s): "
|
||||
doom-version)
|
||||
default-directory
|
||||
(if (member doom-version news-files)
|
||||
doom-version
|
||||
(concat (mapconcat #'number-to-string
|
||||
(nbutlast (version-to-list doom-version) 1)
|
||||
".")
|
||||
".x"))
|
||||
t doom-version))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-autodefs (autodef)
|
||||
"Open documentation for an autodef.
|
||||
|
||||
An autodef is a Doom concept. It is a function or macro that is always defined,
|
||||
whether or not its containing module is disabled (in which case it will safely
|
||||
no-op without evaluating its arguments). This syntactic sugar lets you use them
|
||||
without needing to check if they are available."
|
||||
(interactive
|
||||
(let* ((settings
|
||||
(cl-loop with case-fold-search = nil
|
||||
for sym being the symbols of obarray
|
||||
for sym-name = (symbol-name sym)
|
||||
if (and (or (functionp sym)
|
||||
(macrop sym))
|
||||
(string-match-p "[a-z]!$" sym-name))
|
||||
collect sym))
|
||||
(sym (symbol-at-point))
|
||||
(autodef
|
||||
(completing-read
|
||||
"Describe setter: "
|
||||
;; TODO Could be cleaner (refactor me!)
|
||||
(cl-loop with maxwidth = (apply #'max (mapcar #'length (mapcar #'symbol-name settings)))
|
||||
for def in (sort settings #'string-lessp)
|
||||
if (get def 'doom-module)
|
||||
collect
|
||||
(format (format "%%-%ds%%s" (+ maxwidth 4))
|
||||
def (propertize (format "%s %s" (car it) (cdr it))
|
||||
'face 'font-lock-comment-face))
|
||||
else if (and (string-match-p "^set-.+!$" (symbol-name def))
|
||||
(symbol-file def)
|
||||
(file-in-directory-p (symbol-file def) doom-core-dir))
|
||||
collect
|
||||
(format (format "%%-%ds%%s" (+ maxwidth 4))
|
||||
def (propertize (format "lisp/%s.el" (file-name-sans-extension (file-relative-name (symbol-file def) doom-core-dir)))
|
||||
'face 'font-lock-comment-face)))
|
||||
nil t
|
||||
(when (and (symbolp sym)
|
||||
(string-match-p "!$" (symbol-name sym)))
|
||||
(symbol-name sym)))))
|
||||
(list (and autodef (car (split-string autodef " "))))))
|
||||
(or (stringp autodef)
|
||||
(functionp autodef)
|
||||
(signal 'wrong-type-argument (list '(stringp functionp) autodef)))
|
||||
(let ((fn (if (functionp autodef)
|
||||
autodef
|
||||
(intern-soft autodef))))
|
||||
(or (fboundp fn)
|
||||
(error "'%s' is not a valid DOOM autodef" autodef))
|
||||
(if (fboundp 'helpful-callable)
|
||||
(helpful-callable fn)
|
||||
(describe-function fn))))
|
||||
|
||||
(defun doom--help-modules-list ()
|
||||
(cl-loop for path in (cdr (doom-module-load-path 'all))
|
||||
for (cat . mod) = (doom-module-from-path path)
|
||||
for readme-path = (or (doom-module-locate-path cat mod "README.org")
|
||||
(doom-module-locate-path cat mod))
|
||||
for format = (format "%s %s" cat mod)
|
||||
if (doom-module-p cat mod)
|
||||
collect (list format readme-path)
|
||||
else if (and cat mod)
|
||||
collect (list (propertize format 'face 'font-lock-comment-face)
|
||||
readme-path)))
|
||||
|
||||
(defun doom--help-current-module-str ()
|
||||
(cond ((save-excursion
|
||||
(require 'smartparens)
|
||||
(ignore-errors
|
||||
(sp-beginning-of-sexp)
|
||||
(unless (eq (char-after) ?\()
|
||||
(backward-char))
|
||||
(let ((sexp (sexp-at-point)))
|
||||
(when (memq (car-safe sexp) '(featurep! require!))
|
||||
(format "%s %s" (nth 1 sexp) (nth 2 sexp)))))))
|
||||
((when buffer-file-name
|
||||
(when-let (mod (doom-module-from-path buffer-file-name))
|
||||
(unless (memq (car mod) '(:core :private))
|
||||
(format "%s %s" (car mod) (cdr mod))))))
|
||||
((when-let (mod (cdr (assq major-mode doom--help-major-mode-module-alist)))
|
||||
(format "%s %s"
|
||||
(symbol-name (car mod))
|
||||
(symbol-name (cadr mod)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-modules (category module &optional visit-dir)
|
||||
"Open the documentation for a Doom module.
|
||||
|
||||
CATEGORY is a keyword and MODULE is a symbol. e.g. :editor and 'evil.
|
||||
|
||||
If VISIT-DIR is non-nil, visit the module's directory rather than its
|
||||
documentation.
|
||||
|
||||
Automatically selects a) the module at point (in private init files), b) the
|
||||
module derived from a `featurep!' or `require!' call, c) the module that the
|
||||
current file is in, or d) the module associated with the current major mode (see
|
||||
`doom--help-major-mode-module-alist')."
|
||||
(interactive
|
||||
(nconc
|
||||
(mapcar #'intern
|
||||
(split-string
|
||||
(completing-read "Describe module: "
|
||||
(doom--help-modules-list)
|
||||
nil t nil nil
|
||||
(doom--help-current-module-str))
|
||||
" " t))
|
||||
(list current-prefix-arg)))
|
||||
(cl-check-type category symbol)
|
||||
(cl-check-type module symbol)
|
||||
(cl-destructuring-bind (module-string path)
|
||||
(or (assoc (format "%s %s" category module) (doom--help-modules-list))
|
||||
(user-error "'%s %s' is not a valid module" category module))
|
||||
(setq module-string (substring-no-properties module-string))
|
||||
(unless (file-readable-p path)
|
||||
(error "Can't find or read %S module at %S" module-string path))
|
||||
(cond ((not (file-directory-p path))
|
||||
(if visit-dir
|
||||
(doom-project-browse (file-name-directory path))
|
||||
(find-file path)))
|
||||
(visit-dir
|
||||
(doom-project-browse path))
|
||||
((y-or-n-p (format "The %S module has no README file. Explore its directory?"
|
||||
module-string))
|
||||
(doom-project-browse (file-name-directory path)))
|
||||
((user-error "Aborted module lookup")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-custom-variable (var)
|
||||
"Look up documentation for a custom variable.
|
||||
|
||||
Unlike `helpful-variable', which casts a wider net that includes internal
|
||||
variables, this only lists variables that exist to be customized (defined with
|
||||
`defcustom')."
|
||||
(interactive
|
||||
(list (helpful--read-symbol
|
||||
"Custom variable: "
|
||||
(helpful--variable-at-point)
|
||||
(lambda (sym)
|
||||
(and (helpful--variable-p sym)
|
||||
(custom-variable-p sym)
|
||||
;; Exclude minor mode state variables, which aren't meant to be
|
||||
;; modified directly, but through their associated function.
|
||||
(not (or (and (string-suffix-p "-mode" (symbol-name sym))
|
||||
(fboundp sym))
|
||||
(eq (get sym 'custom-set) 'custom-set-minor-mode))))))))
|
||||
(helpful-variable var))
|
||||
|
||||
|
||||
;;
|
||||
;;; `doom/help-packages'
|
||||
|
||||
(defun doom--help-insert-button (label &optional uri line)
|
||||
"Helper function to insert a button at point.
|
||||
|
||||
The button will have the text LABEL. If URI is given, the button will open it,
|
||||
otherwise the LABEL will be used. If the uri to open is a url it will be opened
|
||||
in a browser. If LINE is given (and the uri to open is not a url), then the file
|
||||
will open with point on that line."
|
||||
(let ((uri (or uri label)))
|
||||
(insert-text-button
|
||||
label
|
||||
'face 'link
|
||||
'follow-link t
|
||||
'action
|
||||
(if (string-match-p "^https?://" uri)
|
||||
(lambda (_) (browse-url uri))
|
||||
(unless (file-exists-p uri)
|
||||
(error "Path does not exist: %S" uri))
|
||||
(lambda (_)
|
||||
(when (window-dedicated-p)
|
||||
(other-window 1))
|
||||
(find-file uri)
|
||||
(when line
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line))
|
||||
(recenter)))))))
|
||||
|
||||
(defun doom--help-package-configs (package)
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
;; TODO Use ripgrep instead
|
||||
(split-string
|
||||
(cdr (doom-call-process
|
||||
"git" "grep" "--no-break" "--no-heading" "--line-number"
|
||||
(format "%s %s\\($\\| \\)"
|
||||
"\\(^;;;###package\\|(after!\\|(use-package!\\)"
|
||||
package)
|
||||
":(exclude)*.org"))
|
||||
"\n" t)))
|
||||
|
||||
(defvar doom--help-packages-list nil)
|
||||
;;;###autoload
|
||||
(defun doom/help-packages (package)
|
||||
"Like `describe-package', but for packages installed by Doom modules.
|
||||
|
||||
Only shows installed packages. Includes information about where packages are
|
||||
defined and configured.
|
||||
|
||||
If prefix arg is present, refresh the cache."
|
||||
(interactive
|
||||
(let ((guess (or (function-called-at-point)
|
||||
(symbol-at-point))))
|
||||
(require 'finder-inf nil t)
|
||||
(require 'package)
|
||||
(require 'straight)
|
||||
(let ((packages
|
||||
(if (and doom--help-packages-list (null current-prefix-arg))
|
||||
doom--help-packages-list
|
||||
(message "Generating packages list for the first time...")
|
||||
(redisplay)
|
||||
(setq doom--help-packages-list
|
||||
(delete-dups
|
||||
(append (mapcar #'car package-alist)
|
||||
(mapcar #'car package--builtins)
|
||||
(mapcar #'intern
|
||||
(hash-table-keys straight--build-cache))
|
||||
(mapcar #'car (doom-package-list 'all))
|
||||
nil))))))
|
||||
(unless (memq guess packages)
|
||||
(setq guess nil))
|
||||
(list
|
||||
(intern
|
||||
(completing-read (format "Describe Doom package (%s): "
|
||||
(concat (when guess
|
||||
(format "default '%s', " guess))
|
||||
(format "total %d" (length packages))))
|
||||
packages nil t nil nil
|
||||
(when guess (symbol-name guess))))))))
|
||||
;; TODO Refactor me.
|
||||
(require 'doom-packages)
|
||||
(doom-initialize-packages)
|
||||
(help-setup-xref (list #'doom/help-packages package)
|
||||
(called-interactively-p 'interactive))
|
||||
(with-help-window (help-buffer)
|
||||
(with-current-buffer standard-output
|
||||
(when (or (package-desc-p package)
|
||||
(and (symbolp package)
|
||||
(or (assq package package-alist)
|
||||
(assq package package--builtins))))
|
||||
(describe-package-1 package))
|
||||
(let ((indent (make-string 13 ? )))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward " Status: .*$" nil t)
|
||||
(insert "\n")
|
||||
(search-forward "\n\n" nil t))
|
||||
|
||||
(package--print-help-section "Package")
|
||||
(insert (symbol-name package) "\n")
|
||||
|
||||
(package--print-help-section "Source")
|
||||
(pcase (doom-package-backend package)
|
||||
(`straight
|
||||
(insert "Straight\n")
|
||||
(package--print-help-section "Pinned")
|
||||
(insert (if-let (pin (plist-get (cdr (assq package doom-packages)) :pin))
|
||||
pin
|
||||
"unpinned")
|
||||
"\n")
|
||||
|
||||
(package--print-help-section "Build")
|
||||
(let ((default-directory (straight--repos-dir (symbol-name package))))
|
||||
(if (file-exists-p default-directory)
|
||||
(insert (cdr (doom-call-process "git" "log" "-1" "--format=%D %h %ci")))
|
||||
(insert "n/a")))
|
||||
(insert "\n" indent)
|
||||
|
||||
(package--print-help-section "Build location")
|
||||
(let ((build-dir (straight--build-dir (symbol-name package))))
|
||||
(if (file-exists-p build-dir)
|
||||
(doom--help-insert-button (abbreviate-file-name build-dir))
|
||||
(insert "n/a")))
|
||||
(insert "\n" indent)
|
||||
|
||||
(package--print-help-section "Repo location")
|
||||
(let* ((local-repo (doom-package-recipe-repo package))
|
||||
(repo-dir (straight--repos-dir local-repo)))
|
||||
(if (file-exists-p repo-dir)
|
||||
(doom--help-insert-button (abbreviate-file-name repo-dir))
|
||||
(insert "n/a"))
|
||||
(insert "\n"))
|
||||
|
||||
(let ((recipe (doom-package-build-recipe package)))
|
||||
(package--print-help-section "Recipe")
|
||||
(insert
|
||||
(replace-regexp-in-string "\n" (concat "\n" indent)
|
||||
(pp-to-string recipe))))
|
||||
|
||||
(package--print-help-section "Homepage")
|
||||
(doom--help-insert-button (doom-package-homepage package)))
|
||||
|
||||
(`elpa (insert "[M]ELPA ")
|
||||
(doom--help-insert-button (doom-package-homepage package))
|
||||
(package--print-help-section "Location")
|
||||
(doom--help-insert-button
|
||||
(abbreviate-file-name
|
||||
(file-name-directory
|
||||
(locate-library (symbol-name package))))))
|
||||
(`builtin (insert "Built-in\n")
|
||||
(package--print-help-section "Location")
|
||||
(doom--help-insert-button
|
||||
(abbreviate-file-name
|
||||
(file-name-directory
|
||||
(locate-library (symbol-name package))))))
|
||||
(`other (doom--help-insert-button
|
||||
(abbreviate-file-name
|
||||
(or (symbol-file package)
|
||||
(locate-library (symbol-name package))))))
|
||||
(_ (insert "Not installed")))
|
||||
(insert "\n")
|
||||
|
||||
(when-let
|
||||
(modules
|
||||
(if (gethash (symbol-name package) straight--build-cache)
|
||||
(doom-package-get package :modules)
|
||||
(plist-get (cdr (assq package (doom-package-list 'all)))
|
||||
:modules)))
|
||||
(package--print-help-section "Modules")
|
||||
(insert "Declared by the following Doom modules:\n")
|
||||
(dolist (m modules)
|
||||
(let* ((module-path (pcase (car m)
|
||||
(:core doom-core-dir)
|
||||
(:private doom-private-dir)
|
||||
(category
|
||||
(doom-module-locate-path category
|
||||
(cdr m)))))
|
||||
(readme-path (expand-file-name "README.org" module-path)))
|
||||
(insert indent)
|
||||
(doom--help-insert-button
|
||||
(format "%s %s" (car m) (or (cdr m) ""))
|
||||
module-path)
|
||||
(insert " (")
|
||||
(if (file-exists-p readme-path)
|
||||
(doom--help-insert-button "readme" readme-path)
|
||||
(insert "no readme"))
|
||||
(insert ")\n"))))
|
||||
|
||||
(package--print-help-section "Configs")
|
||||
(if-let ((configs (doom--help-package-configs package)))
|
||||
(progn
|
||||
(insert "This package is configured in the following locations:")
|
||||
(dolist (location configs)
|
||||
(insert "\n" indent)
|
||||
(cl-destructuring-bind (file line _match &rest)
|
||||
(split-string location ":")
|
||||
(doom--help-insert-button location
|
||||
(expand-file-name file doom-emacs-dir)
|
||||
(string-to-number line)))))
|
||||
(insert "This package is not configured anywhere"))
|
||||
(goto-char (point-min))))))
|
||||
|
||||
(defvar doom--package-cache nil)
|
||||
(defun doom--package-list (&optional prompt)
|
||||
(let* ((guess (or (function-called-at-point)
|
||||
(symbol-at-point))))
|
||||
(require 'finder-inf nil t)
|
||||
(unless package--initialized
|
||||
(package-initialize t))
|
||||
(let ((packages (or doom--package-cache
|
||||
(progn
|
||||
(message "Reading packages...")
|
||||
(cl-delete-duplicates
|
||||
(append (mapcar 'car package-alist)
|
||||
(mapcar 'car package--builtins)
|
||||
(mapcar 'car package-archive-contents)))))))
|
||||
(setq doom--package-cache packages)
|
||||
(unless (memq guess packages)
|
||||
(setq guess nil))
|
||||
(intern (completing-read (or prompt
|
||||
(if guess
|
||||
(format "Select package to search for (default %s): "
|
||||
guess)
|
||||
"Describe package: "))
|
||||
packages nil t nil nil
|
||||
(if guess (symbol-name guess)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-package-config (package)
|
||||
"Jump to any `use-package!', `after!' or ;;;###package block for PACKAGE.
|
||||
|
||||
This only searches `doom-emacs-dir' (typically ~/.emacs.d) and does not include
|
||||
config blocks in your private config."
|
||||
(interactive (list (doom--package-list "Find package config: ")))
|
||||
(cl-destructuring-bind (file line _match)
|
||||
(split-string
|
||||
(completing-read
|
||||
"Jump to config: "
|
||||
(or (doom--help-package-configs package)
|
||||
(user-error "This package isn't configured by you or Doom")))
|
||||
":")
|
||||
(find-file (expand-file-name file doom-emacs-dir))
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line))
|
||||
(recenter)))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'doom/help-package-homepage #'straight-visit-package-website)
|
||||
|
||||
(defun doom--help-search-prompt (prompt)
|
||||
(let ((query (doom-thing-at-point-or-region)))
|
||||
(if (featurep 'counsel)
|
||||
query
|
||||
(read-string prompt query 'git-grep query))))
|
||||
|
||||
(defvar counsel-rg-base-command)
|
||||
(defun doom--help-search (dirs query prompt)
|
||||
;; REVIEW Replace with deadgrep
|
||||
(unless (executable-find "rg")
|
||||
(user-error "Can't find ripgrep on your system"))
|
||||
(cond ((fboundp 'consult--grep)
|
||||
(consult--grep
|
||||
prompt
|
||||
(lambda (input)
|
||||
(pcase-let* ((cmd (split-string-and-unquote consult-ripgrep-args))
|
||||
(type (consult--ripgrep-regexp-type (car cmd)))
|
||||
(`(,arg . ,opts) (consult--command-split input))
|
||||
(`(,re . ,hl) (funcall consult--regexp-compiler arg type)))
|
||||
(when re
|
||||
(list :command
|
||||
(append cmd
|
||||
(and (eq type 'pcre) '("-P"))
|
||||
(list "-e" (consult--join-regexps re type))
|
||||
opts
|
||||
dirs)
|
||||
:highlight hl))))
|
||||
data-directory query))
|
||||
((fboundp 'counsel-rg)
|
||||
(let ((counsel-rg-base-command
|
||||
(if (stringp counsel-rg-base-command)
|
||||
(format counsel-rg-base-command
|
||||
(concat "%s " (mapconcat #'shell-quote-argument dirs " ")))
|
||||
(append counsel-rg-base-command dirs))))
|
||||
(counsel-rg query nil "-Lz" (concat prompt ": "))))
|
||||
;; () TODO Helm support?
|
||||
((grep-find
|
||||
(string-join
|
||||
(append (list "rg" "-L" "--search-zip" "--no-heading" "--color=never"
|
||||
(shell-quote-argument query))
|
||||
(mapcar #'shell-quote-argument dirs))
|
||||
" ")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-load-path (query)
|
||||
"Perform a text search on your `load-path'.
|
||||
Uses the symbol at point or the current selection, if available."
|
||||
(interactive
|
||||
(list (doom--help-search-prompt "Search load-path: ")))
|
||||
(doom--help-search (cl-remove-if-not #'file-directory-p load-path)
|
||||
query "Search load-path: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/help-search-loaded-files (query)
|
||||
"Perform a text search on your `load-path'.
|
||||
Uses the symbol at point or the current selection, if available."
|
||||
(interactive
|
||||
(list (doom--help-search-prompt "Search loaded files: ")))
|
||||
(doom--help-search
|
||||
(cl-loop for (file . _) in (cl-remove-if-not #'stringp load-history :key #'car)
|
||||
for filebase = (file-name-sans-extension file)
|
||||
if (file-exists-p! (or (format "%s.el.gz" filebase)
|
||||
(format "%s.el" filebase)))
|
||||
collect it)
|
||||
query "Search loaded files: "))
|
||||
307
lisp/lib/packages.el
Normal file
307
lisp/lib/packages.el
Normal file
|
|
@ -0,0 +1,307 @@
|
|||
;;; 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 (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 '(: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 (lambda! ((cat . mod))
|
||||
(if-let (packages-file
|
||||
(pcase cat
|
||||
(:private (car (doom-glob doom-private-dir "packages.el")))
|
||||
(:core (car (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 (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-let (packages-file (doom-module-locate-path (car module) (cdr module)))
|
||||
(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))
|
||||
(let (targets lines)
|
||||
(save-excursion
|
||||
(while (re-search-forward "^modified +\\(.+\\)$" nil t)
|
||||
(cl-pushnew (doom-module-from-path (match-string 1)) targets
|
||||
:test #'equal)))
|
||||
(while (re-search-forward "^-" nil t)
|
||||
(let ((file (magit-file-at-point))
|
||||
before after)
|
||||
(and (save-window-excursion
|
||||
(call-interactively #'magit-diff-visit-file)
|
||||
(when (or (looking-at-p "(package!")
|
||||
(re-search-forward "(package! " (line-end-position) t)
|
||||
(re-search-backward "(package! " nil t))
|
||||
(let ((buffer-file-name file))
|
||||
(cl-destructuring-bind (&key package plist _beg _end)
|
||||
(doom--package-at-point)
|
||||
(setq before (doom--package-to-bump-string package plist))))))
|
||||
(re-search-forward "^+" nil t)
|
||||
(save-window-excursion
|
||||
(call-interactively #'magit-diff-visit-file)
|
||||
(or (looking-at-p "(package!")
|
||||
(re-search-forward "(package! " (line-end-position) t)
|
||||
(re-search-backward "(package! "))
|
||||
(let ((buffer-file-name file))
|
||||
(cl-destructuring-bind (&key package plist _beg _end)
|
||||
(doom--package-at-point)
|
||||
(setq after (doom--package-to-bump-string package plist)))))
|
||||
(cl-pushnew (format "%s -> %s" before after) lines))))
|
||||
(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))))))
|
||||
61
lisp/lib/plist.el
Normal file
61
lisp/lib/plist.el
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
;;; lisp/lib/plist.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Macros
|
||||
|
||||
;;; DEPRECATED In favor of `cl-callf'
|
||||
;;;###autoload
|
||||
(defmacro plist-put! (plist &rest rest)
|
||||
"Set each PROP VALUE pair in REST to PLIST in-place."
|
||||
`(cl-loop for (prop value)
|
||||
on (list ,@rest) by #'cddr
|
||||
do ,(if (symbolp plist)
|
||||
`(setq ,plist (plist-put ,plist prop value))
|
||||
`(plist-put ,plist prop value))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-get (plist prop &optional nil-value)
|
||||
"Return PROP in PLIST, if it exists. Otherwise NIL-VALUE."
|
||||
(if-let (val (plist-member plist prop))
|
||||
(cadr val)
|
||||
nil-value))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-merge (from-plist to-plist)
|
||||
"Non-destructively merge FROM-PLIST onto TO-PLIST"
|
||||
(let ((plist (copy-sequence from-plist)))
|
||||
(while plist
|
||||
(cl-callf plist-put to-plist (pop plist) (pop plist)))
|
||||
to-plist))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-delete-nil (plist)
|
||||
"Delete `nil' properties from a copy of PLIST."
|
||||
(let (p)
|
||||
(while plist
|
||||
(if (car plist)
|
||||
(cl-callf plist-put p (car plist) (nth 1 plist)))
|
||||
(setq plist (cddr plist)))
|
||||
p))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-keys (plist)
|
||||
"Return the keys in PLIST."
|
||||
(let (keys)
|
||||
(while plist
|
||||
(push (car plist) keys)
|
||||
(setq plist (cddr plist)))
|
||||
keys))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-plist-values (plist)
|
||||
"Return the values in PLIST."
|
||||
(let (keys)
|
||||
(while plist
|
||||
(push (cadr plist) keys)
|
||||
(setq plist (cddr plist)))
|
||||
keys))
|
||||
472
lisp/lib/print.el
Normal file
472
lisp/lib/print.el
Normal file
|
|
@ -0,0 +1,472 @@
|
|||
;;; lisp/lib/print.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary
|
||||
;;;
|
||||
;;; This is Doom's output library, for controlling what does and doesn't get
|
||||
;;; logged, and provides a simple DSL for formatting output. It's mainly to
|
||||
;;; serve the noninteractive use-case, as `message' is more than good enough in
|
||||
;;; interactive sessions, but `print!' and `doom-log' are safe to use as a
|
||||
;;; drop-in replacement.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(require 'ansi-color)
|
||||
|
||||
(defvar doom-print-ansi-alist
|
||||
'(;; fx
|
||||
(bold 1 :weight bold)
|
||||
(dark 2)
|
||||
(italic 3 :slant italic)
|
||||
(underscore 4 :underline t)
|
||||
(blink 5)
|
||||
(rapid 6)
|
||||
(contrary 7)
|
||||
(concealed 8)
|
||||
(strike 9 :strike-through t)
|
||||
;; fg
|
||||
(black 30 term-color-black)
|
||||
(red 31 term-color-red)
|
||||
(green 32 term-color-green)
|
||||
(yellow 33 term-color-yellow)
|
||||
(blue 34 term-color-blue)
|
||||
(magenta 35 term-color-magenta)
|
||||
(cyan 36 term-color-cyan)
|
||||
(white 37 term-color-white)
|
||||
;; bg
|
||||
(on-black 40 term-color-black)
|
||||
(on-red 41 term-color-red)
|
||||
(on-green 42 term-color-green)
|
||||
(on-yellow 43 term-color-yellow)
|
||||
(on-blue 44 term-color-blue)
|
||||
(on-magenta 45 term-color-magenta)
|
||||
(on-cyan 46 term-color-cyan)
|
||||
(on-white 47 term-color-white))
|
||||
"An alist of fg/bg/fx names mapped to ansi codes and term-color-* variables.
|
||||
|
||||
This serves as the cipher for converting (COLOR ...) function calls in `print!'
|
||||
and `format!' into colored output, where COLOR is any car of this list.")
|
||||
|
||||
(defvar doom-print-class-alist
|
||||
`((buffer . doom-print--buffer)
|
||||
(color . doom-print--style)
|
||||
(class . doom-print--class)
|
||||
(indent . doom-print--indent)
|
||||
(fill . doom-print--fill)
|
||||
(join . doom-print--join)
|
||||
(org . doom-print--org)
|
||||
(markup . doom-print--cli-markup)
|
||||
(trim . string-trim)
|
||||
(rtrim . string-trim-right)
|
||||
(ltrim . string-trim-left)
|
||||
(p . doom-print--paragraph)
|
||||
(buffer . (lambda (buffer)
|
||||
(with-current-buffer buffer
|
||||
(buffer-string))))
|
||||
(truncate . doom-print--truncate)
|
||||
(success . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'green
|
||||
(doom-print--indent str "✓ ")
|
||||
args)))
|
||||
(warn . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'yellow
|
||||
(doom-print--indent str "! ")
|
||||
args)))
|
||||
(error . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'red
|
||||
(doom-print--indent str "x ")
|
||||
args)))
|
||||
(item . (lambda (str &rest args)
|
||||
(doom-print--indent
|
||||
(if args (apply #'format str args) str)
|
||||
"- ")))
|
||||
(start . (lambda (str &rest args)
|
||||
(doom-print--indent
|
||||
(if args (apply #'format str args) str)
|
||||
"> ")))
|
||||
(path . abbreviate-file-name)
|
||||
(symbol . symbol-name)
|
||||
(relpath . (lambda (str &optional dir)
|
||||
(if (or (not str)
|
||||
(not (stringp str))
|
||||
(string-blank-p str))
|
||||
str
|
||||
(let ((dir (or dir (file-truename default-directory)))
|
||||
(str (file-truename str)))
|
||||
(if (file-in-directory-p str dir)
|
||||
(file-relative-name str dir)
|
||||
(abbreviate-file-name str))))))
|
||||
(filename . file-name-nondirectory)
|
||||
(dirname . (lambda (path)
|
||||
(unless (file-directory-p path)
|
||||
(setq path (file-name-directory path)))
|
||||
(directory-file-name path))))
|
||||
"An alist of text classes that map to transformation functions.
|
||||
|
||||
Any of these classes can be called like functions from within `format!' and
|
||||
`print!' calls, which will transform their input.")
|
||||
|
||||
(defvar doom-print-indent 0
|
||||
"Level to rigidly indent text returned by `format!' and `print!'.")
|
||||
|
||||
(defvar doom-print-indent-increment 2
|
||||
"Steps in which to increment `doom-print-indent' for consecutive levels.")
|
||||
|
||||
(defvar doom-print-backend (if noninteractive 'ansi 'text-properties)
|
||||
"Whether to print colors/styles with ANSI codes or with text properties.
|
||||
|
||||
Accepts `ansi' and `text-properties'. `nil' means don't render styles at all.")
|
||||
|
||||
(defvar doom-print-level (if init-file-debug 'debug 'info)
|
||||
"The default level of messages to print.")
|
||||
|
||||
(defvar doom-print-logging-level 'debug
|
||||
"The default logging level used by `doom-log'/`doom-print'.")
|
||||
|
||||
(defvar doom-print-message-level (if noninteractive 'debug 'info)
|
||||
"The default logging level used by `message'.")
|
||||
|
||||
(defvar doom-print--levels
|
||||
'(debug ; the system is thinking out loud
|
||||
info ; a FYI; to keep you posted
|
||||
warning ; a dismissable issue that may have reprecussions later
|
||||
error)) ; functionality has been disabled by misbehavior
|
||||
|
||||
(dotimes (i (length doom-print--levels))
|
||||
(put (nth i doom-print--levels) 'level i))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun doom-print
|
||||
(output &key
|
||||
(format t)
|
||||
(newline t)
|
||||
(stream standard-output)
|
||||
(level doom-print-level))
|
||||
"Print OUTPUT to stdout.
|
||||
|
||||
Unlike `message', this:
|
||||
- Respects `standard-output'.
|
||||
- Respects `doom-print-indent' (if FORMAT)
|
||||
- Prints to stdout instead of stderr in batch mode.
|
||||
- Respects more ANSI codes (only in batch mode).
|
||||
- No-ops if OUTPUT is nil or an empty/blank string.
|
||||
|
||||
Returns OUTPUT."
|
||||
(cl-check-type output (or null string))
|
||||
(when (and (stringp output)
|
||||
(not (string-blank-p output))
|
||||
(or (eq level t)
|
||||
(>= (get level 'level)
|
||||
(get doom-print-level 'level))))
|
||||
(let ((output (if format
|
||||
(doom-print--format "%s" output)
|
||||
output)))
|
||||
(princ output stream)
|
||||
(if newline (terpri stream))
|
||||
output)))
|
||||
|
||||
;;;###autoload
|
||||
(progn
|
||||
;; Autoload whole definition, so its buried uses don't pull in this whole file
|
||||
;; with them at expansion time.
|
||||
(defmacro doom-log (output &rest args)
|
||||
"Log a message in *Messages*.
|
||||
|
||||
Does not emit the message in the echo area. This is a macro instead of a
|
||||
function to prevent the potentially expensive execution of its arguments when
|
||||
debug mode is off."
|
||||
`(when (or init-file-debug noninteractive)
|
||||
(let ((inhibit-message t))
|
||||
(message
|
||||
"%s" (propertize
|
||||
(doom-print--format
|
||||
(format
|
||||
"* [%s] %s"
|
||||
,(let ((time `(format "%.06f" (float-time (time-subtract (current-time) before-init-time)))))
|
||||
(cond (noninteractive time)
|
||||
((bound-and-true-p doom--current-module)
|
||||
(format "[:%s %s] "
|
||||
(doom-keyword-name (car doom--current-module))
|
||||
(cdr doom--current-module)))
|
||||
((when-let (file (ignore-errors (file!)))
|
||||
(format "[%s] "
|
||||
(file-relative-name
|
||||
file (doom-path (file-name-directory file) "../")))))
|
||||
(time)))
|
||||
,output)
|
||||
,@args)
|
||||
'face 'font-lock-doc-face))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro format! (message &rest args)
|
||||
"An alternative to `format' that understands (color ...) and converts them
|
||||
into faces or ANSI codes depending on the type of sesssion we're in."
|
||||
`(doom-print--format ,@(doom-print--apply `(,message ,@args))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group! (&rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
`(print-group-if! t ,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group-if! (condition &rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
(declare (indent 1))
|
||||
`(let ((doom-print-indent
|
||||
(+ (if ,condition doom-print-indent-increment 0)
|
||||
doom-print-indent)))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
"Prints MESSAGE, formatted with ARGS, to stdout.
|
||||
|
||||
Returns non-nil if the message is a non-empty string.
|
||||
|
||||
Can be colored using (color ...) blocks:
|
||||
|
||||
(print! \"Hello %s\" (bold (blue \"How are you?\")))
|
||||
(print! \"Hello %s\" (red \"World\"))
|
||||
(print! (green \"Great %s!\") \"success\")
|
||||
|
||||
Uses faces in interactive sessions and ANSI codes otherwise."
|
||||
`(doom-print (format! ,message ,@args) :format nil))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro insert! (&rest args)
|
||||
"Like `insert', but with the power of `format!'.
|
||||
|
||||
Each argument in ARGS can be a list, as if they were arguments to `format!':
|
||||
\(MESSAGE [ARGS...]).
|
||||
|
||||
\(fn &rest (MESSAGE . ARGS)...)"
|
||||
`(insert ,@(cl-loop for arg in args
|
||||
if (listp arg)
|
||||
collect `(format! ,@arg)
|
||||
else collect arg)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--format (message &rest args)
|
||||
(if (or (null message) (string-blank-p message))
|
||||
""
|
||||
(concat (make-string doom-print-indent 32)
|
||||
(replace-regexp-in-string
|
||||
"\n" (concat "\n" (make-string doom-print-indent 32))
|
||||
(if args (apply #'format message args) message)
|
||||
t t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--indent (text &optional prefix)
|
||||
"Indent TEXT by WIDTH spaces. If ARGS, format TEXT with them."
|
||||
(with-temp-buffer
|
||||
(let ((width
|
||||
(cond ((null prefix)
|
||||
doom-print-indent-increment)
|
||||
((integerp prefix)
|
||||
prefix)
|
||||
((length (ansi-color-filter-apply (format "%s" prefix)))))))
|
||||
(insert (format "%s" (or text "")))
|
||||
(indent-rigidly (point-min) (point-max) width)
|
||||
(when (stringp prefix)
|
||||
(goto-char (point-min))
|
||||
(delete-char width)
|
||||
(insert prefix))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--fill (message &optional column indent)
|
||||
"Ensure MSG is split into lines no longer than `fill-column'."
|
||||
(with-temp-buffer
|
||||
(let* ((fill-column (or column fill-column))
|
||||
(col 0)
|
||||
(indent (or indent 0))
|
||||
(fill-prefix (make-string indent ?\s)))
|
||||
(save-excursion
|
||||
(insert (format "%s" (or message ""))))
|
||||
;; HACK This monkey patches `fill-region' to not count ANSI codes as
|
||||
;; legitimate characters, when calculating per-line `fill-column'.
|
||||
(letf! (defun current-fill-column ()
|
||||
(let ((target (funcall current-fill-column)))
|
||||
(save-excursion
|
||||
(goto-char (line-beginning-position))
|
||||
(let ((n 0)
|
||||
(c 0))
|
||||
(while (and (not (eolp)) (<= n target))
|
||||
(save-match-data
|
||||
(if (looking-at ansi-color-control-seq-regexp)
|
||||
(let ((len (length (match-string 0))))
|
||||
(cl-incf c len)
|
||||
(forward-char len))
|
||||
(cl-incf n 1)
|
||||
(forward-char 1))))
|
||||
(+ target c (length fill-prefix))))))
|
||||
(fill-region (point-min) (point-max) nil t))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--paragraph (&rest lines)
|
||||
"TODO"
|
||||
(doom-print--fill (apply #'concat lines)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--join (sequence &optional separator)
|
||||
"Ensure SEQUENCE is joined with SEPARATOR.
|
||||
|
||||
`nil' and empty strings in SEQUENCE are omitted."
|
||||
(mapconcat (doom-partial #'format "%s")
|
||||
(seq-remove (fn! (or (null %)
|
||||
(and (stringp %)
|
||||
(string-empty-p %))))
|
||||
sequence)
|
||||
(or separator " ")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--truncate (text &optional col ellipsis)
|
||||
"Replaces basic org markup with ansi/text-properties."
|
||||
(truncate-string-to-width (or text "") (or col (- fill-column doom-print-indent))
|
||||
nil nil (or ellipsis "...")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--buffer (buffer &optional beg end)
|
||||
"Replaces basic org markup with ansi/text-properties."
|
||||
(if (and (bufferp buffer) (buffer-live-p buffer))
|
||||
(with-current-buffer buffer
|
||||
(if (or beg end)
|
||||
(buffer-substring (or beg (point-min))
|
||||
(or end (point-max)))
|
||||
(buffer-string)))
|
||||
""))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--cli-markup (text)
|
||||
"Replace `...', `...`, and ```...``` quotes in TEXT with CLI formatting.
|
||||
|
||||
- `$ENVVAR' = bolded
|
||||
- `--switch' = bolded
|
||||
- `ARG' = underlined
|
||||
- `symbol' = highlighted in blue
|
||||
- `arbitrary code` = highlighted in blue
|
||||
- ```
|
||||
Arbitrary multiline code gets highlighted in blue too.
|
||||
```"
|
||||
(if (not text) ""
|
||||
(let ((case-fold-search nil))
|
||||
;; TODO Syntax highlighting?
|
||||
(replace-regexp-in-string
|
||||
" *```\n\\(.+?\\)\n *```" (doom-print--style 'blue "%s" "\\1")
|
||||
(replace-regexp-in-string
|
||||
"`\\$ \\([^`\n]+?\\)`" (format "`%s`" (doom-print--style 'blue "%s" "\\1"))
|
||||
(replace-regexp-in-string
|
||||
"`\\([^ \n]+?\\)'"
|
||||
(let ((styles '(("^\\$" . envvar)
|
||||
("^--?" . option)
|
||||
("^[A-Z][A-Z0-9-_]*$" . arg)
|
||||
("." . symbol))))
|
||||
(lambda (match)
|
||||
(let ((text (match-string 1 match)))
|
||||
(pcase (assoc-default text styles #'string-match-p)
|
||||
(`arg (doom-print--style 'underscore "%s" text))
|
||||
(`envvar (doom-print--style 'bold "%s" text))
|
||||
(`option (doom-print--style 'bold "%s" text))
|
||||
(_ (format "`%s'" (doom-print--style 'blue "%s" text)))))))
|
||||
text t)
|
||||
t)
|
||||
t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--org (text)
|
||||
"Replaces basic Org markup with ansi/text-properties.
|
||||
|
||||
All emphasis markers need to be preceded by a backslash."
|
||||
(let* ((inhibit-modification-hooks t)
|
||||
(styles '((?* . bold)
|
||||
(?_ . underscore)
|
||||
(?/ . italic)
|
||||
(?= . magenta)
|
||||
(?+ . strike)
|
||||
(?~ . blue)))
|
||||
(fences (regexp-quote (mapconcat #'char-to-string (mapcar #'car styles) ""))))
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert text))
|
||||
(while (re-search-forward (format "\\([%s]\\)" fences) nil t)
|
||||
(unless (= (char-before (match-beginning 0)) ?\\)
|
||||
(let* ((beg (match-beginning 0))
|
||||
(ibeg (point))
|
||||
(fence (match-string 1))
|
||||
(fence-re (regexp-quote fence)))
|
||||
(when (re-search-forward (format "[^\\]%s" fence-re) (line-end-position 2) t)
|
||||
(let ((end (point))
|
||||
(iend (1- (point))))
|
||||
(let ((text (buffer-substring ibeg iend)))
|
||||
(when-let (style (cdr (assq (string-to-char fence) styles)))
|
||||
(goto-char beg)
|
||||
(delete-region beg end)
|
||||
(insert (doom-print--style style "%s" text)))))
|
||||
(goto-char beg)))))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--style (style format &rest args)
|
||||
"Apply STYLE to formatted MESSAGE with ARGS.
|
||||
|
||||
STYLE is a symbol that correlates to `doom-print-ansi-alist'.
|
||||
|
||||
In a noninteractive session, this wraps the result in ansi color codes.
|
||||
Otherwise, it maps colors to a term-color-* face."
|
||||
(let* ((code (cadr (assq style doom-print-ansi-alist)))
|
||||
(format (format "%s" (or format "")))
|
||||
(message (if args (apply #'format format args) format)))
|
||||
(unless code
|
||||
(error "Invalid print style: %s" style))
|
||||
(pcase doom-print-backend
|
||||
(`ansi
|
||||
(format "\e[0%dm%s\e[%dm" code message 0))
|
||||
(`text-properties
|
||||
(require 'term) ; piggyback on term's color faces
|
||||
(propertize
|
||||
message
|
||||
'face
|
||||
(append (get-text-property 0 'face format)
|
||||
(cond ((>= code 40)
|
||||
`(:background ,(caddr (assq style doom-print-ansi-alist))))
|
||||
((>= code 30)
|
||||
`(:foreground ,(face-foreground (caddr (assq style doom-print-ansi-alist)))))
|
||||
((cddr (assq style doom-print-ansi-alist)))))))
|
||||
(_ message))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--class (class format &rest args)
|
||||
"Apply CLASS to formatted format with ARGS.
|
||||
|
||||
CLASS is derived from `doom-print-class-alist', and can contain any arbitrary,
|
||||
transformative logic."
|
||||
(let (fn)
|
||||
(cond ((setq fn (cdr (assq class doom-print-class-alist)))
|
||||
(if (functionp fn)
|
||||
(apply fn format args)
|
||||
(error "%s does not have a function" class)))
|
||||
(args (apply #'format format args))
|
||||
(format))))
|
||||
|
||||
(defun doom-print--apply (forms &optional sub)
|
||||
"Replace color-name functions with calls to `doom-print--style'."
|
||||
(cond ((null forms) nil)
|
||||
((listp forms)
|
||||
(append (cond ((not (symbolp (car forms)))
|
||||
(list (doom-print--apply (car forms))))
|
||||
(sub
|
||||
(list (car forms)))
|
||||
((assq (car forms) doom-print-ansi-alist)
|
||||
`(doom-print--style ',(car forms)))
|
||||
((assq (car forms) doom-print-class-alist)
|
||||
`(doom-print--class ',(car forms)))
|
||||
((list (car forms))))
|
||||
(doom-print--apply (cdr forms) t)
|
||||
nil))
|
||||
(forms)))
|
||||
42
lisp/lib/process.el
Normal file
42
lisp/lib/process.el
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
;;; lisp/lib/process.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-call-process (command &rest args)
|
||||
"Execute COMMAND with ARGS synchronously.
|
||||
|
||||
Returns (STATUS . OUTPUT) when it is done, where STATUS is the returned error
|
||||
code of the process and OUTPUT is its stdout output."
|
||||
(with-temp-buffer
|
||||
(cons (or (apply #'call-process command nil t nil (remq nil args))
|
||||
-1)
|
||||
(string-trim (buffer-string)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-exec-process (command &rest args)
|
||||
"Execute COMMAND with ARGS synchronously.
|
||||
|
||||
Unlike `doom-call-process', this pipes output to `standard-output' on the fly to
|
||||
simulate 'exec' in the shell, so batch scripts could run external programs
|
||||
synchronously without sacrificing their output.
|
||||
|
||||
Warning: freezes indefinitely on any stdin prompt."
|
||||
;; FIXME Is there any way to handle prompts?
|
||||
(with-temp-buffer
|
||||
(cons (let ((process
|
||||
(make-process :name "doom-sh"
|
||||
:buffer (current-buffer)
|
||||
:command (cons command (remq nil args))
|
||||
:connection-type 'pipe))
|
||||
done-p)
|
||||
(set-process-filter
|
||||
process (lambda (_process output)
|
||||
(princ output (current-buffer))
|
||||
(princ (doom--format output))))
|
||||
(set-process-sentinel
|
||||
process (lambda (process _event)
|
||||
(when (memq (process-status process) '(exit stop))
|
||||
(setq done-p t))))
|
||||
(while (not done-p)
|
||||
(sit-for 0.1))
|
||||
(process-exit-status process))
|
||||
(string-trim (buffer-string)))))
|
||||
180
lisp/lib/projects.el
Normal file
180
lisp/lib/projects.el
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
;;; lisp/lib/projects.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; HACK We forward declare these variables because they are let-bound in a
|
||||
;; number of places with no guarantee that they've been defined yet (i.e.
|
||||
;; that `projectile' is loaded). If a variable is defined with `defvar'
|
||||
;; while it is lexically bound, you get "Defining as dynamic an already
|
||||
;; lexical var" errors in Emacs 28+).
|
||||
;;;###autoload (defvar projectile-project-root nil)
|
||||
;;;###autoload (defvar projectile-enable-caching (not noninteractive))
|
||||
;;;###autoload (defvar projectile-require-project-root 'prompt)
|
||||
|
||||
;;;###autodef
|
||||
(cl-defun set-project-type! (name &key predicate compile run test configure dir)
|
||||
"Add a project type to `projectile-project-type'."
|
||||
(declare (indent 1))
|
||||
(after! projectile
|
||||
(add-to-list 'projectile-project-types
|
||||
(list name
|
||||
'marker-files predicate
|
||||
'compilation-dir dir
|
||||
'configure-command configure
|
||||
'compile-command compile
|
||||
'test-command test
|
||||
'run-command run))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Macros
|
||||
|
||||
;;;###autoload
|
||||
(defmacro project-file-exists-p! (files)
|
||||
"Checks if the project has the specified FILES.
|
||||
Paths are relative to the project root, unless they start with ./ or ../ (in
|
||||
which case they're relative to `default-directory'). If they start with a slash,
|
||||
they are absolute."
|
||||
`(file-exists-p! ,files (doom-project-root)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/find-file-in-other-project (project-root)
|
||||
"Performs `projectile-find-file' in a known project of your choosing."
|
||||
(interactive
|
||||
(list
|
||||
(completing-read "Find file in project: " (projectile-relevant-known-projects))))
|
||||
(unless (file-directory-p project-root)
|
||||
(error "Project directory '%s' doesn't exist" project-root))
|
||||
(doom-project-find-file project-root))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/browse-in-other-project (project-root)
|
||||
"Performs `find-file' in a known project of your choosing."
|
||||
(interactive
|
||||
(list
|
||||
(completing-read "Browse in project: " (projectile-relevant-known-projects))))
|
||||
(unless (file-directory-p project-root)
|
||||
(error "Project directory '%s' doesn't exist" project-root))
|
||||
(doom-project-browse project-root))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/browse-in-emacsd ()
|
||||
"Browse files from `doom-emacs-dir'."
|
||||
(interactive) (doom-project-browse doom-emacs-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/find-file-in-emacsd ()
|
||||
"Find a file under `doom-emacs-dir', recursively."
|
||||
(interactive) (doom-project-find-file doom-emacs-dir))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/add-directory-as-project (dir)
|
||||
"Register an arbitrary directory as a project.
|
||||
|
||||
Unlike `projectile-add-known-project', if DIR isn't a valid project, a .project
|
||||
file will be created within it so that it will always be treated as one. This
|
||||
command will throw an error if a parent of DIR is a valid project (which would
|
||||
mask DIR)."
|
||||
(interactive "D")
|
||||
(let ((short-dir (abbreviate-file-name dir)))
|
||||
(unless (file-equal-p (doom-project-root dir) dir)
|
||||
(with-temp-file (doom-path dir ".project")))
|
||||
(let ((proj-dir (doom-project-root dir)))
|
||||
(unless (file-equal-p proj-dir dir)
|
||||
(user-error "Can't add %S as a project, because %S is already a project"
|
||||
short-dir (abbreviate-file-name proj-dir)))
|
||||
(message "%S was not a project; adding .project file to it"
|
||||
short-dir (abbreviate-file-name proj-dir))
|
||||
(projectile-add-known-project dir))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-p (&optional dir)
|
||||
"Return t if DIR (defaults to `default-directory') is a valid project."
|
||||
(and (doom-project-root dir)
|
||||
t))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-root (&optional dir)
|
||||
"Return the project root of DIR (defaults to `default-directory').
|
||||
Returns nil if not in a project."
|
||||
(let ((projectile-project-root
|
||||
(unless dir (bound-and-true-p projectile-project-root)))
|
||||
projectile-require-project-root)
|
||||
(projectile-project-root dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-name (&optional dir)
|
||||
"Return the name of the current project.
|
||||
|
||||
Returns '-' if not in a valid project."
|
||||
(if-let (project-root (or (doom-project-root dir)
|
||||
(if dir (expand-file-name dir))))
|
||||
(funcall projectile-project-name-function project-root)
|
||||
"-"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-expand (name &optional dir)
|
||||
"Expand NAME to project root."
|
||||
(expand-file-name name (doom-project-root dir)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-find-file (dir)
|
||||
"Jump to a file in DIR (searched recursively).
|
||||
|
||||
If DIR is not a project, it will be indexed (but not cached)."
|
||||
(unless (file-directory-p dir)
|
||||
(error "Directory %S does not exist" dir))
|
||||
(unless (file-readable-p dir)
|
||||
(error "Directory %S isn't readable" dir))
|
||||
(let* ((default-directory (file-truename dir))
|
||||
(projectile-project-root (doom-project-root dir))
|
||||
(projectile-enable-caching projectile-enable-caching))
|
||||
(cond ((and projectile-project-root (file-equal-p projectile-project-root default-directory))
|
||||
(unless (doom-project-p default-directory)
|
||||
;; Disable caching if this is not a real project; caching
|
||||
;; non-projects easily has the potential to inflate the projectile
|
||||
;; cache beyond reason.
|
||||
(setq projectile-enable-caching nil))
|
||||
(call-interactively
|
||||
;; Intentionally avoid `helm-projectile-find-file', because it runs
|
||||
;; asynchronously, and thus doesn't see the lexical
|
||||
;; `default-directory'
|
||||
(if (doom-module-p :completion 'ivy)
|
||||
#'counsel-projectile-find-file
|
||||
#'projectile-find-file)))
|
||||
((and (bound-and-true-p vertico-mode)
|
||||
(fboundp '+vertico/find-file-in))
|
||||
(+vertico/find-file-in default-directory))
|
||||
((and (bound-and-true-p ivy-mode)
|
||||
(fboundp 'counsel-file-jump))
|
||||
(call-interactively #'counsel-file-jump))
|
||||
((project-current nil dir)
|
||||
(project-find-file-in nil nil dir))
|
||||
((and (bound-and-true-p helm-mode)
|
||||
(fboundp 'helm-find-files))
|
||||
(call-interactively #'helm-find-files))
|
||||
((call-interactively #'find-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-browse (dir)
|
||||
"Traverse a file structure starting linearly from DIR."
|
||||
(let ((default-directory (file-truename (expand-file-name dir))))
|
||||
(call-interactively
|
||||
(cond ((doom-module-p :completion 'ivy)
|
||||
#'counsel-find-file)
|
||||
((doom-module-p :completion 'helm)
|
||||
#'helm-find-files)
|
||||
(#'find-file)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-project-ignored-p (project-root)
|
||||
"Return non-nil if temporary file or a straight package."
|
||||
(unless (file-remote-p project-root)
|
||||
(or (file-in-directory-p project-root temporary-file-directory)
|
||||
(file-in-directory-p project-root doom-local-dir))))
|
||||
183
lisp/lib/sandbox.el
Normal file
183
lisp/lib/sandbox.el
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
;;; lisp/lib/sandbox.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-sandbox-buffer-name "*doom:sandbox*"
|
||||
"Name of the Doom sandbox buffer.")
|
||||
|
||||
(defvar doom-sandbox-dir
|
||||
(expand-file-name "doom-sandbox" (temporary-file-directory))
|
||||
"TODO")
|
||||
|
||||
(defvar doom-sandbox-preamble
|
||||
";; Welcome to the sandbox!
|
||||
;;
|
||||
;; This is a test bed for running Emacs Lisp in another instance of Emacs that
|
||||
;; has varying amounts of Doom loaded:
|
||||
;;
|
||||
;; - vanilla Emacs (nothing loaded) \\[doom--run-vanilla-emacs]
|
||||
;; - vanilla Doom (only Doom core) \\[doom--run-vanilla-doom]
|
||||
;; - Doom + modules - your private config \\[doom--run-vanilla-doom+]
|
||||
;; - Doom + modules + your private config \\[doom--run-full-doom]
|
||||
;;
|
||||
;; This is done without sacrificing access to installed packages. Use the sandbox
|
||||
;; to reproduce bugs and determine if Doom is to blame.\n\n"
|
||||
"TODO")
|
||||
|
||||
(defun doom--sandbox-launch (args forms)
|
||||
(require 'package)
|
||||
(require 'restart-emacs)
|
||||
(let* ((sandbox-file (expand-file-name "init.el" doom-sandbox-dir))
|
||||
(args (append args (list "-l" sandbox-file))))
|
||||
(delete-directory doom-sandbox-dir 'recursive)
|
||||
(make-directory doom-sandbox-dir 'parents)
|
||||
(with-temp-file sandbox-file
|
||||
(prin1 forms (current-buffer)))
|
||||
(condition-case-unless-debug e
|
||||
(cond ((display-graphic-p)
|
||||
(if (memq system-type '(windows-nt ms-dos))
|
||||
(restart-emacs--start-gui-on-windows args)
|
||||
(restart-emacs--start-gui-using-sh args)))
|
||||
((memq system-type '(windows-nt ms-dos))
|
||||
(user-error "Cannot start another Emacs from Windows shell."))
|
||||
((suspend-emacs
|
||||
(format "%s %s -nw; fg"
|
||||
(shell-quote-argument (restart-emacs--get-emacs-binary))
|
||||
(mapconcat #'shell-quote-argument args " ")))))
|
||||
(error
|
||||
(delete-directory doom-sandbox-dir 'recursive)
|
||||
(signal (car e) (cdr e))))))
|
||||
|
||||
|
||||
(defun doom--sandbox-run (&optional mode)
|
||||
"TODO"
|
||||
(doom--sandbox-launch
|
||||
(unless (eq mode 'doom) '("-Q"))
|
||||
(let ((forms
|
||||
(read (format "(progn\n%s\n)"
|
||||
(buffer-substring-no-properties
|
||||
(point-min)
|
||||
(point-max))))))
|
||||
(if (eq mode 'doom)
|
||||
forms
|
||||
`(progn
|
||||
;; doom variables
|
||||
(setq init-file-debug t
|
||||
doom-emacs-dir ,doom-emacs-dir
|
||||
doom-cache-dir ,(expand-file-name "cache/" doom-sandbox-dir)
|
||||
doom-etc-dir ,(expand-file-name "etc/" doom-sandbox-dir))
|
||||
(defun doom--write-to-etc-dir-a (fn &rest args)
|
||||
(let ((user-emacs-directory doom-etc-dir))
|
||||
(apply fn args)))
|
||||
(advice-add #'locate-user-emacs-file :around #'doom--write-to-etc-dir-a)
|
||||
;; emacs essential variables
|
||||
(setq before-init-time (current-time)
|
||||
after-init-time nil
|
||||
init-file-debug init-file-debug
|
||||
noninteractive nil
|
||||
process-environment (get 'process-environment 'initial-value)
|
||||
exec-path (get 'exec-path 'initial-value)
|
||||
load-path ',load-path
|
||||
user-init-file load-file-name)
|
||||
;; package.el
|
||||
(setq package--init-file-ensured t
|
||||
package-user-dir ,package-user-dir
|
||||
package-archives ',package-archives)
|
||||
;; (add-hook 'kill-emacs-hook
|
||||
;; (lambda ()
|
||||
;; (delete-file user-init-file)
|
||||
;; (when (file-equal-p user-emacs-directory ,doom-sandbox-dir)
|
||||
;; (delete-directory user-emacs-directory 'recursive))))
|
||||
(with-eval-after-load 'undo-tree
|
||||
;; HACK `undo-tree' sometimes throws errors because
|
||||
;; `buffer-undo-tree' isn't correctly initialized.
|
||||
(setq-default buffer-undo-tree (make-undo-tree)))
|
||||
;; Then launch as much about Emacs as we can
|
||||
(defun --run-- () ,forms)
|
||||
,(pcase mode
|
||||
(`doom
|
||||
'(--run--))
|
||||
(`vanilla-doom+ ; Doom core + modules - private config
|
||||
`(progn
|
||||
(load-file ,(expand-file-name "doom.el" doom-core-dir))
|
||||
(setq doom-modules-dirs (list doom-modules-dir))
|
||||
(let ((doom-init-modules-p t))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core-modules))
|
||||
(setq doom-modules ',doom-modules)
|
||||
(maphash (lambda (key plist)
|
||||
(doom-module-put
|
||||
(car key) (cdr key)
|
||||
:path (doom-module-locate-path (car key) (cdr key))))
|
||||
doom-modules)
|
||||
(--run--)
|
||||
(maphash (doom-module-loader doom-module-init-file) doom-modules)
|
||||
(maphash (doom-module-loader doom-module-config-file) doom-modules)
|
||||
(doom-run-hooks 'doom-init-modules-hook)))
|
||||
(`vanilla-doom ; only Doom core
|
||||
`(progn
|
||||
(load-file ,(expand-file-name "doom.el" doom-core-dir))
|
||||
(let ((doom-init-modules-p t))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core-modules))
|
||||
(--run--)))
|
||||
(`vanilla ; nothing loaded
|
||||
`(progn
|
||||
(if (boundp 'comp-deferred-compilation)
|
||||
;; REVIEW Remove me after a month
|
||||
(setq comp-deferred-compilation nil
|
||||
comp-deferred-compilation-deny-list ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
comp-async-env-modifier-form ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
comp-eln-load-path ',(bound-and-true-p native-comp-eln-load-path))
|
||||
(setq native-comp-deferred-compilation nil
|
||||
native-comp-deferred-compilation-deny-list ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
native-comp-async-env-modifier-form ',(bound-and-true-p native-comp-async-env-modifier-form)
|
||||
native-comp-eln-load-path ',(bound-and-true-p native-comp-eln-load-path)))
|
||||
(package-initialize t)
|
||||
(--run--))))
|
||||
;; Then rerun Emacs' startup hooks to simulate a fresh Emacs session,
|
||||
;; because they've already fired.
|
||||
(fset 'doom-run-hook #',(symbol-function #'doom-run-hook))
|
||||
(fset 'doom-run-hooks #',(symbol-function #'doom-run-hooks))
|
||||
(fset 'doom-run-all-startup-hooks-h #',(symbol-function #'doom-run-all-startup-hooks-h))
|
||||
(doom-run-all-startup-hooks-h))))))
|
||||
|
||||
(fset 'doom--run-vanilla-emacs (cmd! (doom--sandbox-run 'vanilla)))
|
||||
(fset 'doom--run-vanilla-doom (cmd! (doom--sandbox-run 'vanilla-doom)))
|
||||
(fset 'doom--run-vanilla-doom+ (cmd! (doom--sandbox-run 'vanilla-doom+)))
|
||||
(fset 'doom--run-full-doom (cmd! (doom--sandbox-run 'doom)))
|
||||
|
||||
(defvar doom-sandbox-emacs-lisp-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c C-c") #'doom--run-vanilla-emacs)
|
||||
(define-key map (kbd "C-c C-d") #'doom--run-vanilla-doom)
|
||||
(define-key map (kbd "C-c C-p") #'doom--run-vanilla-doom+)
|
||||
(define-key map (kbd "C-c C-f") #'doom--run-full-doom)
|
||||
(define-key map (kbd "C-c C-k") #'kill-current-buffer)
|
||||
map))
|
||||
|
||||
(define-derived-mode doom-sandbox-emacs-lisp-mode emacs-lisp-mode "Sandbox Elisp"
|
||||
"TODO")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/sandbox ()
|
||||
"Open the Emacs Lisp sandbox.
|
||||
|
||||
This is a test bed for running Emacs Lisp in another instance of Emacs with
|
||||
varying amounts of Doom loaded, including:
|
||||
|
||||
a) vanilla Emacs (nothing loaded),
|
||||
b) vanilla Doom (only Doom core),
|
||||
c) Doom + modules - your private config or
|
||||
c) Doom + modules + your private config (a complete Doom session)
|
||||
|
||||
This is done without sacrificing access to installed packages. Use the sandbox
|
||||
to reproduce bugs and determine if Doom is to blame."
|
||||
(interactive)
|
||||
(pop-to-buffer
|
||||
(with-current-buffer (get-buffer-create doom-sandbox-buffer-name)
|
||||
(doom-sandbox-emacs-lisp-mode)
|
||||
(setq-local default-directory doom-emacs-dir)
|
||||
(and (buffer-live-p (get-buffer doom-sandbox-buffer-name))
|
||||
(= (buffer-size) 0)
|
||||
(insert (substitute-command-keys doom-sandbox-preamble)))
|
||||
(goto-char (point-max))
|
||||
(current-buffer))))
|
||||
199
lisp/lib/scratch.el
Normal file
199
lisp/lib/scratch.el
Normal file
|
|
@ -0,0 +1,199 @@
|
|||
;;; lisp/lib/scratch.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-scratch-default-file "__default"
|
||||
"The default file name for a project-less scratch buffer.
|
||||
|
||||
Will be saved in `doom-scratch-dir'.")
|
||||
|
||||
(defvar doom-scratch-dir (concat doom-etc-dir "scratch")
|
||||
"Where to save persistent scratch buffers.")
|
||||
|
||||
(defvar doom-scratch-initial-major-mode nil
|
||||
"What major mode to start fresh scratch buffers in.
|
||||
|
||||
Scratch buffers preserve their last major mode, however, so this only affects
|
||||
the first, fresh scratch buffer you create. This accepts:
|
||||
|
||||
t Inherits the major mode of the last buffer you had selected.
|
||||
nil Uses `fundamental-mode'
|
||||
MAJOR-MODE Any major mode symbol")
|
||||
|
||||
(defvar doom-scratch-buffers nil
|
||||
"A list of active scratch buffers.")
|
||||
|
||||
(defvar doom-scratch-current-project nil
|
||||
"The name of the project associated with the current scratch buffer.")
|
||||
(put 'doom-scratch-current-project 'permanent-local t)
|
||||
|
||||
(defvar doom-scratch-buffer-hook ()
|
||||
"The hooks to run after a scratch buffer is created.")
|
||||
|
||||
|
||||
(defun doom--load-persistent-scratch-buffer (project-name)
|
||||
(setq-local doom-scratch-current-project
|
||||
(or project-name
|
||||
doom-scratch-default-file))
|
||||
(let ((smart-scratch-file
|
||||
(expand-file-name (concat doom-scratch-current-project ".el")
|
||||
doom-scratch-dir)))
|
||||
(make-directory doom-scratch-dir t)
|
||||
(when (file-readable-p smart-scratch-file)
|
||||
(message "Reading %s" smart-scratch-file)
|
||||
(cl-destructuring-bind (content point mode)
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert-file-contents smart-scratch-file))
|
||||
(read (current-buffer)))
|
||||
(erase-buffer)
|
||||
(funcall mode)
|
||||
(insert content)
|
||||
(goto-char point)
|
||||
t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-scratch-buffer (&optional dont-restore-p mode directory project-name)
|
||||
"Return a scratchpad buffer in major MODE."
|
||||
(let* ((buffer-name (if project-name
|
||||
(format "*doom:scratch (%s)*" project-name)
|
||||
"*doom:scratch*"))
|
||||
(buffer (get-buffer buffer-name)))
|
||||
(with-current-buffer
|
||||
(or buffer (get-buffer-create buffer-name))
|
||||
(setq default-directory directory)
|
||||
(setq-local so-long--inhibited t)
|
||||
(if dont-restore-p
|
||||
(erase-buffer)
|
||||
(unless buffer
|
||||
(doom--load-persistent-scratch-buffer project-name)
|
||||
(when (and (eq major-mode 'fundamental-mode)
|
||||
(functionp mode))
|
||||
(funcall mode))))
|
||||
(cl-pushnew (current-buffer) doom-scratch-buffers)
|
||||
(add-transient-hook! 'doom-switch-buffer-hook (doom-persist-scratch-buffers-h))
|
||||
(add-transient-hook! 'doom-switch-window-hook (doom-persist-scratch-buffers-h))
|
||||
(add-hook 'kill-buffer-hook #'doom-persist-scratch-buffer-h nil 'local)
|
||||
(run-hooks 'doom-scratch-buffer-created-hook)
|
||||
(current-buffer))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Persistent scratch buffer
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-persist-scratch-buffer-h ()
|
||||
"Save the current buffer to `doom-scratch-dir'."
|
||||
(let ((content (buffer-substring-no-properties (point-min) (point-max)))
|
||||
(point (point))
|
||||
(mode major-mode))
|
||||
(with-temp-file
|
||||
(expand-file-name (concat (or doom-scratch-current-project
|
||||
doom-scratch-default-file)
|
||||
".el")
|
||||
doom-scratch-dir)
|
||||
(prin1 (list content
|
||||
point
|
||||
mode)
|
||||
(current-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-persist-scratch-buffers-h ()
|
||||
"Save all scratch buffers to `doom-scratch-dir'."
|
||||
(setq doom-scratch-buffers
|
||||
(cl-delete-if-not #'buffer-live-p doom-scratch-buffers))
|
||||
(dolist (buffer doom-scratch-buffers)
|
||||
(with-current-buffer buffer
|
||||
(doom-persist-scratch-buffer-h))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-persist-scratch-buffers-after-switch-h ()
|
||||
"Kill scratch buffers when they are no longer visible, saving them to disk."
|
||||
(unless (cl-some #'get-buffer-window doom-scratch-buffers)
|
||||
(mapc #'kill-buffer doom-scratch-buffers)
|
||||
(remove-hook 'doom-switch-buffer-hook #'doom-persist-scratch-buffers-after-switch-h)))
|
||||
|
||||
;;;###autoload
|
||||
(unless noninteractive
|
||||
(add-hook 'kill-emacs-hook #'doom-persist-scratch-buffers-h))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defvar projectile-enable-caching)
|
||||
;;;###autoload
|
||||
(defun doom/open-scratch-buffer (&optional arg project-p same-window-p)
|
||||
"Pop up a persistent scratch buffer.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer.
|
||||
If PROJECT-P is non-nil, open a persistent scratch buffer associated with the
|
||||
current project."
|
||||
(interactive "P")
|
||||
(let (projectile-enable-caching)
|
||||
(funcall
|
||||
(if same-window-p
|
||||
#'switch-to-buffer
|
||||
#'pop-to-buffer)
|
||||
(doom-scratch-buffer
|
||||
arg
|
||||
(cond ((eq doom-scratch-initial-major-mode t)
|
||||
(unless (or buffer-read-only
|
||||
(derived-mode-p 'special-mode)
|
||||
(string-match-p "^ ?\\*" (buffer-name)))
|
||||
major-mode))
|
||||
((null doom-scratch-initial-major-mode)
|
||||
nil)
|
||||
((symbolp doom-scratch-initial-major-mode)
|
||||
doom-scratch-initial-major-mode))
|
||||
default-directory
|
||||
(when project-p
|
||||
(doom-project-name))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/switch-to-scratch-buffer (&optional arg project-p)
|
||||
"Like `doom/open-scratch-buffer', but switches to it in the current window.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer."
|
||||
(interactive "P")
|
||||
(doom/open-scratch-buffer arg project-p 'same-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/open-project-scratch-buffer (&optional arg same-window-p)
|
||||
"Opens the (persistent) project scratch buffer in a popup.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer."
|
||||
(interactive "P")
|
||||
(doom/open-scratch-buffer arg 'project same-window-p))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/switch-to-project-scratch-buffer (&optional arg)
|
||||
"Like `doom/open-project-scratch-buffer', but switches to it in the current
|
||||
window.
|
||||
|
||||
If passed the prefix ARG, do not restore the last scratch buffer."
|
||||
(interactive "P")
|
||||
(doom/open-project-scratch-buffer arg 'same-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/revert-scratch-buffer ()
|
||||
"Revert scratch buffer to last persistent state."
|
||||
(interactive)
|
||||
(unless (string-match-p "^\\*doom:scratch" (buffer-name))
|
||||
(user-error "Not in a scratch buffer"))
|
||||
(when (doom--load-persistent-scratch-buffer doom-scratch-current-project)
|
||||
(message "Reloaded scratch buffer")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-persistent-scratch-file (&optional arg)
|
||||
"Deletes a scratch buffer file in `doom-scratch-dir'.
|
||||
|
||||
If prefix ARG, delete all persistent scratches."
|
||||
(interactive)
|
||||
(if arg
|
||||
(progn
|
||||
(delete-directory doom-scratch-dir t)
|
||||
(message "Cleared %S" (abbreviate-file-name doom-scratch-dir)))
|
||||
(make-directory doom-scratch-dir t)
|
||||
(let ((file (read-file-name "Delete scratch file > " doom-scratch-dir "scratch")))
|
||||
(if (not (file-exists-p file))
|
||||
(message "%S does not exist" (abbreviate-file-name file))
|
||||
(delete-file file)
|
||||
(message "Successfully deleted %S" (abbreviate-file-name file))))))
|
||||
152
lisp/lib/sessions.el
Normal file
152
lisp/lib/sessions.el
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
;;; lisp/lib/sessions.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar desktop-base-file-name)
|
||||
(defvar desktop-dirname)
|
||||
(defvar desktop-restore-eager)
|
||||
(defvar desktop-file-modtime)
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-session-file (&optional name)
|
||||
"TODO"
|
||||
(cond ((require 'persp-mode nil t)
|
||||
(expand-file-name (or name persp-auto-save-fname) persp-save-dir))
|
||||
((require 'desktop nil t)
|
||||
(if name
|
||||
(expand-file-name name (file-name-directory (desktop-full-file-name)))
|
||||
(desktop-full-file-name)))
|
||||
((error "No session backend available"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-save-session (&optional file)
|
||||
"TODO"
|
||||
(setq file (expand-file-name (or file (doom-session-file))))
|
||||
(cond ((require 'persp-mode nil t)
|
||||
(unless persp-mode (persp-mode +1))
|
||||
(setq persp-auto-save-opt 0)
|
||||
(persp-save-state-to-file file))
|
||||
((and (require 'frameset nil t)
|
||||
(require 'restart-emacs nil t))
|
||||
(let ((frameset-filter-alist (append '((client . restart-emacs--record-tty-file))
|
||||
frameset-filter-alist))
|
||||
(desktop-base-file-name (file-name-nondirectory file))
|
||||
(desktop-dirname (file-name-directory file))
|
||||
(desktop-restore-eager t)
|
||||
desktop-file-modtime)
|
||||
(make-directory desktop-dirname t)
|
||||
;; Prevents confirmation prompts
|
||||
(let ((desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
|
||||
(desktop-save desktop-dirname t))))
|
||||
((error "No session backend to save session with"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-load-session (&optional file)
|
||||
"TODO"
|
||||
(setq file (expand-file-name (or file (doom-session-file))))
|
||||
(message "Attempting to load %s" file)
|
||||
(cond ((not (file-readable-p file))
|
||||
(message "No session file at %S to read from" file))
|
||||
((require 'persp-mode nil t)
|
||||
(unless persp-mode
|
||||
(persp-mode +1))
|
||||
(let ((allowed (persp-list-persp-names-in-file file)))
|
||||
(cl-loop for name being the hash-keys of *persp-hash*
|
||||
unless (member name allowed)
|
||||
do (persp-kill name))
|
||||
(persp-load-state-from-file file)))
|
||||
((and (require 'frameset nil t)
|
||||
(require 'restart-emacs nil t))
|
||||
(restart-emacs--restore-frames-using-desktop file))
|
||||
((error "No session backend to load session with"))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/quickload-session ()
|
||||
"TODO"
|
||||
(interactive)
|
||||
(message "Restoring session...")
|
||||
(doom-load-session)
|
||||
(message "Session restored. Welcome back."))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/quicksave-session ()
|
||||
"TODO"
|
||||
(interactive)
|
||||
(message "Saving session")
|
||||
(doom-save-session)
|
||||
(message "Saving session...DONE"))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/load-session (file)
|
||||
"TODO"
|
||||
(interactive
|
||||
(let ((session-file (doom-session-file)))
|
||||
(list (or (read-file-name "Session to restore: "
|
||||
(file-name-directory session-file)
|
||||
(file-name-nondirectory session-file)
|
||||
t)
|
||||
(user-error "No session selected. Aborting")))))
|
||||
(unless file
|
||||
(error "No session file selected"))
|
||||
(message "Loading '%s' session" file)
|
||||
(doom-load-session file)
|
||||
(message "Session restored. Welcome back."))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/save-session (file)
|
||||
"TODO"
|
||||
(interactive
|
||||
(let ((session-file (doom-session-file)))
|
||||
(list (or (read-file-name "Save session to: "
|
||||
(file-name-directory session-file)
|
||||
(file-name-nondirectory session-file))
|
||||
(user-error "No session selected. Aborting")))))
|
||||
(unless file
|
||||
(error "No session file selected"))
|
||||
(message "Saving '%s' session" file)
|
||||
(doom-save-session file))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/restart ()
|
||||
"Restart Emacs (and the daemon, if active).
|
||||
|
||||
Unlike `doom/restart-and-restore', does not restart the current session."
|
||||
(interactive)
|
||||
(require 'restart-emacs)
|
||||
(restart-emacs))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/restart-and-restore (&optional debug)
|
||||
"Restart Emacs (and the daemon, if active).
|
||||
|
||||
If DEBUG (the prefix arg) is given, start the new instance with the --debug
|
||||
switch."
|
||||
(interactive "P")
|
||||
(require 'restart-emacs)
|
||||
(doom/quicksave-session)
|
||||
(save-some-buffers nil t)
|
||||
(letf! ((#'save-buffers-kill-emacs #'kill-emacs)
|
||||
(confirm-kill-emacs)
|
||||
(tmpfile (make-temp-file "post-load")))
|
||||
;; HACK `restart-emacs' does not properly escape arguments on Windows (in
|
||||
;; `restart-emacs--daemon-on-windows' and
|
||||
;; `restart-emacs--start-gui-on-windows'), so don't give it complex
|
||||
;; arguments at all. Should be fixed upstream, but restart-emacs seems to
|
||||
;; be unmaintained.
|
||||
(with-temp-file tmpfile
|
||||
(print `(progn
|
||||
(when (boundp 'doom-version)
|
||||
(add-hook 'window-setup-hook #'doom-load-session 100))
|
||||
(delete-file ,tmpfile))
|
||||
(current-buffer)))
|
||||
(restart-emacs
|
||||
(append (if debug (list "--debug-init"))
|
||||
(when (boundp 'chemacs-current-emacs-profile)
|
||||
(list "--with-profile" chemacs-current-emacs-profile))
|
||||
(list "-l" tmpfile)))))
|
||||
155
lisp/lib/store.el
Normal file
155
lisp/lib/store.el
Normal file
|
|
@ -0,0 +1,155 @@
|
|||
;;; lisp/lib/cache.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; This little library abstracts the process of writing arbitrary elisp values
|
||||
;; to a 2-tiered file store (in `doom-store-dir'/`doom-store-location').
|
||||
|
||||
(defvar doom-store-dir (concat doom-etc-dir "store/")
|
||||
"Directory to look for and store data accessed through this API.")
|
||||
|
||||
(defvar doom-store-persist-alist ()
|
||||
"An alist of alists, containing lists of variables for the doom cache library
|
||||
to persist across Emacs sessions.")
|
||||
|
||||
(defvar doom-store-location "default"
|
||||
"The default location for cache files. This symbol is translated into a file
|
||||
name under `pcache-directory' (by default a subdirectory under
|
||||
`doom-store-dir'). One file may contain multiple cache entries.")
|
||||
|
||||
(defvar doom--store-table (make-hash-table :test 'equal))
|
||||
|
||||
(defun doom-save-persistent-store-h ()
|
||||
"Hook to persist `doom-store's storage when Emacs is killed."
|
||||
(let (locations)
|
||||
;; Persist `doom-store-persist-alist'
|
||||
(dolist (alist (butlast doom-store-persist-alist 1))
|
||||
(cl-loop with location = (car alist)
|
||||
for var in (cdr alist)
|
||||
do (doom-store-put var (symbol-value var) nil location 'noflush)
|
||||
and do (cl-pushnew location locations :test #'equal)))
|
||||
;; Clean up expired entries,
|
||||
(dolist (location (doom-files-in doom-store-dir :relative-to doom-store-dir))
|
||||
(maphash (lambda (key val)
|
||||
(when (doom--store-expired-p key val)
|
||||
(cl-pushnew location locations :test #'equal)
|
||||
(doom--store-rem key location 'noflush)))
|
||||
(doom--store-init location)))
|
||||
(mapc #'doom--store-flush locations)))
|
||||
(add-hook 'kill-emacs-hook #'doom-save-persistent-store-h)
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-persist (location variables)
|
||||
"Persist VARIABLES (list of symbols) in LOCATION (symbol).
|
||||
This populates these variables with cached values, if one exists, and saves them
|
||||
to file when Emacs quits. This cannot persist buffer-local variables."
|
||||
(cl-check-type location string)
|
||||
(dolist (var variables)
|
||||
(when (doom-store-member-p var location)
|
||||
(set var (doom-store-get var location))))
|
||||
(setf (alist-get location doom-store-persist-alist)
|
||||
(append variables (alist-get location doom-store-persist-alist))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-desist (location &optional variables)
|
||||
"Unregisters VARIABLES (list of symbols) in LOCATION (symbol).
|
||||
Variables to persist are recorded in `doom-store-persist-alist'. Does not affect
|
||||
the actual variables themselves or their values."
|
||||
(cl-check-type location string)
|
||||
(if variables
|
||||
(setf (alist-get location doom-store-persist-alist)
|
||||
(cl-set-difference (cdr (assq location doom-store-persist-alist))
|
||||
variables))
|
||||
(delq! location doom-store-persist-alist 'assoc)))
|
||||
|
||||
(defun doom--store-init (&optional location)
|
||||
(cl-check-type location (or null string))
|
||||
(let ((location (or location doom-store-location)))
|
||||
(or (gethash location doom--store-table)
|
||||
(let* ((file-name-handler-alist nil)
|
||||
(location-path (expand-file-name location doom-store-dir)))
|
||||
(if (file-exists-p location-path)
|
||||
(puthash location
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(setq buffer-file-coding-system 'binary)
|
||||
(insert-file-contents-literally location-path)
|
||||
(read (current-buffer)))
|
||||
doom--store-table)
|
||||
(puthash location (make-hash-table :test 'equal)
|
||||
doom--store-table))))))
|
||||
|
||||
(defun doom--store-expired-p (key data)
|
||||
(let ((ttl (car data)))
|
||||
(cond ((functionp ttl)
|
||||
(not (funcall ttl key data)))
|
||||
((consp ttl)
|
||||
(time-less-p ttl (current-time))))))
|
||||
|
||||
(defun doom--store-flush (location)
|
||||
"Write `doom--store-table' to `doom-store-dir'."
|
||||
(let ((file-name-handler-alist nil)
|
||||
(coding-system-for-write 'binary)
|
||||
(write-region-annotate-functions nil)
|
||||
(write-region-post-annotation-function nil))
|
||||
(let* ((location (or location doom-store-location))
|
||||
(data (doom--store-init location)))
|
||||
(make-directory doom-store-dir 'parents)
|
||||
(with-temp-file (expand-file-name location doom-store-dir)
|
||||
(prin1 data (current-buffer)))
|
||||
data)))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-get (key &optional location default-value noflush)
|
||||
"Retrieve KEY from LOCATION (defaults to `doom-store-location').
|
||||
If it doesn't exist or has expired, DEFAULT_VALUE is returned."
|
||||
(let ((data (gethash key (doom--store-init location) default-value)))
|
||||
(if (not (or (eq data default-value)
|
||||
(doom--store-expired-p key data)))
|
||||
(cdr data)
|
||||
(doom-store-rem key location noflush)
|
||||
default-value)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-put (key value &optional ttl location noflush)
|
||||
"Set KEY to VALUE in the store at LOCATION.
|
||||
KEY can be any lisp object that is comparable with `equal'. TTL is the duration
|
||||
(in seconds) after which this cache entry expires; if nil, no cache expiration.
|
||||
LOCATION is the super-key to store this cache item under. It defaults to
|
||||
`doom-store-location'."
|
||||
(cl-check-type ttl (or null integer function))
|
||||
(puthash key (cons (if (integerp ttl)
|
||||
(time-add (current-time) ttl)
|
||||
ttl)
|
||||
value)
|
||||
(doom--store-init location))
|
||||
(unless noflush
|
||||
(doom--store-flush location)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-rem (key &optional location noflush)
|
||||
"Clear a cache LOCATION (defaults to `doom-store-location')."
|
||||
(remhash key (doom--store-init location))
|
||||
(unless noflush
|
||||
(doom--store-flush location)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-member-p (key &optional location)
|
||||
"Return t if KEY in LOCATION exists.
|
||||
LOCATION defaults to `doom-store-location'."
|
||||
(let ((nil-value (format "--nilvalue%s--" (current-time))))
|
||||
(not (equal (doom-store-get key location nil-value)
|
||||
nil-value))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-store-clear (&optional location)
|
||||
"Clear the store at LOCATION (defaults to `doom-store-location')."
|
||||
(let* ((location (or location doom-store-location))
|
||||
(path (expand-file-name location doom-store-dir)))
|
||||
(remhash location doom--store-table)
|
||||
(when (file-exists-p path)
|
||||
(delete-file path)
|
||||
t)))
|
||||
108
lisp/lib/system.el
Normal file
108
lisp/lib/system.el
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
;;; lisp/lib/system.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-distro ()
|
||||
"Return a symbol representing the installed distro."
|
||||
(cond (IS-WINDOWS 'windows)
|
||||
(IS-MAC 'macos)
|
||||
((and (file-exists-p "/etc/os-release")
|
||||
(with-temp-buffer
|
||||
(insert-file-contents "/etc/os-release")
|
||||
(when (re-search-forward "^ID=\"?\\([^\"\n]+\\)\"?" nil t)
|
||||
(intern (downcase (match-string 1)))))))
|
||||
;; A few redundancies in case os-release fails us
|
||||
((file-exists-p "/etc/debian_version")
|
||||
'debian)
|
||||
((executable-find "nixos-version")
|
||||
'nixos)
|
||||
((and (or (file-exists-p "/etc/config.scm")
|
||||
(file-directory-p "/run/current-system"))
|
||||
(executable-find "guix"))
|
||||
'guix)
|
||||
('linux)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-distro-version ()
|
||||
"Return a distro name and version string."
|
||||
(letf! (defun sh (&rest args) (cdr (apply #'doom-call-process args)))
|
||||
(let ((distro (doom-system-distro)))
|
||||
(cond
|
||||
((eq distro 'windows)
|
||||
(format "Windows %s" "Unknown")) ; TODO
|
||||
((eq distro 'macos)
|
||||
(format "MacOS %s" (sh "sw_vers" "-productVersion")))
|
||||
((executable-find "lsb_release")
|
||||
(sh "lsb_release" "-s" "-d"))
|
||||
((executable-find "nixos-version")
|
||||
(format "NixOS %s" (sh "nixos-version")))
|
||||
((and (file-exists-p "/etc/os-release")
|
||||
(with-temp-buffer
|
||||
(insert-file-contents "/etc/os-release")
|
||||
(when (re-search-forward "^PRETTY_NAME=\"?\\([^\"\n]+\\)\"?" nil t)
|
||||
(match-string 1)))))
|
||||
((when-let (files (doom-glob "/etc/*-release"))
|
||||
(truncate-string-to-width
|
||||
(replace-regexp-in-string "\n" " " (cat (car files) 73) nil t)
|
||||
64 nil nil "...")))
|
||||
((concat "Unknown " (sh "uname" "-v")))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-distro-icon ()
|
||||
"Display icon for the installed distro."
|
||||
(propertize
|
||||
(pcase (doom-system-distro)
|
||||
(`windows (all-the-icons-faicon "windows"))
|
||||
(`macos (all-the-icons-faicon "apple"))
|
||||
(`arch "\uF303")
|
||||
(`debian "\uF306")
|
||||
(`raspbian "\uF315")
|
||||
(`ubuntu "\uF31b")
|
||||
(`elementary "\uF309")
|
||||
(`fedora "\uF30a")
|
||||
(`coreos "\uF305")
|
||||
(`gentoo "\uF30d")
|
||||
(`mageia "\uF310")
|
||||
(`centos "\uF304")
|
||||
((or `opensuse `tumbleweed) "\uF314")
|
||||
(`sabayon "\uF317")
|
||||
(`slackware "\uF319")
|
||||
(`linuxmint "\uF30e")
|
||||
(`alpine "\uF300")
|
||||
(`aosc "\uF301")
|
||||
(`nixos "\uF313")
|
||||
(`devuan "\uF307")
|
||||
(`manjaro "\uF312")
|
||||
((or `void `artix) "\uF17c")
|
||||
(_ (all-the-icons-faicon "linux")))
|
||||
'face '(:height 1)
|
||||
'display '(raise 0)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-system-cpus ()
|
||||
"Return the max number of processing units on this system.
|
||||
Tries to be portable. Returns 1 if cannot be determined."
|
||||
(or (get 'doom-system-cpus 'cached-value)
|
||||
(put 'doom-system-cpus 'cached-value
|
||||
(let ((cpus
|
||||
(cond ((fboundp 'w32-get-nproc)
|
||||
(w32-get-nproc))
|
||||
((getenv "NUMBER_OF_PROCESSORS"))
|
||||
((executable-find "nproc")
|
||||
(doom-call-process "nproc"))
|
||||
((executable-find "sysctl")
|
||||
(doom-call-process "sysctl" "-n" "hw.ncpu")))))
|
||||
(max
|
||||
1 (or (cl-typecase cpus
|
||||
(integer cpus)
|
||||
(string
|
||||
(condition-case _
|
||||
(string-to-number cpus)
|
||||
(wrong-type-argument
|
||||
(user-error "NUMBER_OF_PROCESSORS contains an invalid value: %S"
|
||||
cpus))))
|
||||
(cons
|
||||
(if (zerop (car cpus))
|
||||
(string-to-number (cdr cpus))
|
||||
(user-error "Failed to look up number of processors, because:\n\n%s"
|
||||
(cdr cpus)))))
|
||||
1))))))
|
||||
350
lisp/lib/text.el
Normal file
350
lisp/lib/text.el
Normal file
|
|
@ -0,0 +1,350 @@
|
|||
;;; lisp/lib/text.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-point-in-comment-functions ()
|
||||
"List of functions to run to determine if point is in a comment.
|
||||
|
||||
Each function takes one argument: the position of the point. Stops on the first
|
||||
function to return non-nil. Used by `doom-point-in-comment-p'.")
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-point-in-string-functions ()
|
||||
"List of functions to run to determine if point is in a string.
|
||||
|
||||
Each function takes one argument: the position of the point. Stops on the first
|
||||
function to return non-nil. Used by `doom-point-in-string-p'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-surrounded-p (pair &optional inline balanced)
|
||||
"Returns t if point is surrounded by a brace delimiter: {[(
|
||||
|
||||
If INLINE is non-nil, only returns t if braces are on the same line, and
|
||||
whitespace is balanced on either side of the cursor.
|
||||
|
||||
If INLINE is nil, returns t if the opening and closing braces are on adjacent
|
||||
lines, above and below, with only whitespace in between."
|
||||
(when pair
|
||||
(let ((beg (plist-get pair :beg))
|
||||
(end (plist-get pair :end))
|
||||
(pt (point)))
|
||||
(when (and (> pt beg) (< pt end))
|
||||
(when-let* ((cl (plist-get pair :cl))
|
||||
(op (plist-get pair :op)))
|
||||
(and (not (string= op ""))
|
||||
(not (string= cl ""))
|
||||
(let ((nbeg (+ (length op) beg))
|
||||
(nend (- end (length cl))))
|
||||
(let ((content (buffer-substring-no-properties nbeg nend)))
|
||||
(and (string-match-p (format "[ %s]*" (if inline "" "\n")) content)
|
||||
(or (not balanced)
|
||||
(= (- pt nbeg) (- nend pt))))))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-point-in-comment-p (&optional pos)
|
||||
"Return non-nil if POS is in a comment.
|
||||
POS defaults to the current position."
|
||||
(let ((pos (or pos (point))))
|
||||
(if doom-point-in-comment-functions
|
||||
(run-hook-with-args-until-success 'doom-point-in-comment-functions pos)
|
||||
(nth 4 (syntax-ppss pos)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-point-in-string-p (&optional pos)
|
||||
"Return non-nil if POS is in a string."
|
||||
;; REVIEW Should we cache `syntax-ppss'?
|
||||
(let ((pos (or pos (point))))
|
||||
(if doom-point-in-string-functions
|
||||
(run-hook-with-args-until-success 'doom-point-in-string-functions pos)
|
||||
(nth 3 (syntax-ppss pos)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-point-in-string-or-comment-p (&optional pos)
|
||||
"Return non-nil if POS is in a string or comment."
|
||||
(or (doom-point-in-string-p pos)
|
||||
(doom-point-in-comment-p pos)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-region-active-p ()
|
||||
"Return non-nil if selection is active.
|
||||
Detects evil visual mode as well."
|
||||
(declare (side-effect-free t))
|
||||
(or (use-region-p)
|
||||
(and (bound-and-true-p evil-local-mode)
|
||||
(evil-visual-state-p))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-region-beginning ()
|
||||
"Return beginning position of selection.
|
||||
Uses `evil-visual-beginning' if available."
|
||||
(declare (side-effect-free t))
|
||||
(or (and (bound-and-true-p evil-local-mode)
|
||||
(markerp evil-visual-beginning)
|
||||
(marker-position evil-visual-beginning))
|
||||
(region-beginning)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-region-end ()
|
||||
"Return end position of selection.
|
||||
Uses `evil-visual-end' if available."
|
||||
(declare (side-effect-free t))
|
||||
(if (bound-and-true-p evil-local-mode)
|
||||
evil-visual-end
|
||||
(region-end)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-thing-at-point-or-region (&optional thing prompt)
|
||||
"Grab the current selection, THING at point, or xref identifier at point.
|
||||
|
||||
Returns THING if it is a string. Otherwise, if nothing is found at point and
|
||||
PROMPT is non-nil, prompt for a string (if PROMPT is a string it'll be used as
|
||||
the prompting string). Returns nil if all else fails.
|
||||
|
||||
NOTE: Don't use THING for grabbing symbol-at-point. The xref fallback is smarter
|
||||
in some cases."
|
||||
(declare (side-effect-free t))
|
||||
(cond ((stringp thing)
|
||||
thing)
|
||||
((doom-region-active-p)
|
||||
(buffer-substring-no-properties
|
||||
(doom-region-beginning)
|
||||
(doom-region-end)))
|
||||
(thing
|
||||
(thing-at-point thing t))
|
||||
((require 'xref nil t)
|
||||
;; Eglot, nox (a fork of eglot), and elpy implementations for
|
||||
;; `xref-backend-identifier-at-point' betray the documented purpose of
|
||||
;; the interface. Eglot/nox return a hardcoded string and elpy prepends
|
||||
;; the line number to the symbol.
|
||||
(if (memq (xref-find-backend) '(eglot elpy nox))
|
||||
(thing-at-point 'symbol t)
|
||||
;; A little smarter than using `symbol-at-point', though in most
|
||||
;; cases, xref ends up using `symbol-at-point' anyway.
|
||||
(xref-backend-identifier-at-point (xref-find-backend))))
|
||||
(prompt
|
||||
(read-string (if (stringp prompt) prompt "")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defun doom--bol-bot-eot-eol (&optional pos)
|
||||
(save-mark-and-excursion
|
||||
(when pos
|
||||
(goto-char pos))
|
||||
(let* ((bol (if visual-line-mode
|
||||
(save-excursion
|
||||
(beginning-of-visual-line)
|
||||
(point))
|
||||
(line-beginning-position)))
|
||||
(bot (save-excursion
|
||||
(goto-char bol)
|
||||
(skip-chars-forward " \t\r")
|
||||
(point)))
|
||||
(eol (if visual-line-mode
|
||||
(save-excursion (end-of-visual-line) (point))
|
||||
(line-end-position)))
|
||||
(eot (or (save-excursion
|
||||
(if (not comment-use-syntax)
|
||||
(progn
|
||||
(goto-char bol)
|
||||
(when (re-search-forward comment-start-skip eol t)
|
||||
(or (match-end 1) (match-beginning 0))))
|
||||
(goto-char eol)
|
||||
(while (and (doom-point-in-comment-p)
|
||||
(> (point) bol))
|
||||
(backward-char))
|
||||
(skip-chars-backward " " bol)
|
||||
(or (eq (char-after) 32)
|
||||
(eolp)
|
||||
(bolp)
|
||||
(forward-char))
|
||||
(point)))
|
||||
eol)))
|
||||
(list bol bot eot eol))))
|
||||
|
||||
(defvar doom--last-backward-pt nil)
|
||||
;;;###autoload
|
||||
(defun doom/backward-to-bol-or-indent (&optional point)
|
||||
"Jump between the indentation column (first non-whitespace character) and the
|
||||
beginning of the line. The opposite of
|
||||
`doom/forward-to-last-non-comment-or-eol'."
|
||||
(interactive "^d")
|
||||
(let ((pt (or point (point))))
|
||||
(cl-destructuring-bind (bol bot _eot _eol)
|
||||
(doom--bol-bot-eot-eol pt)
|
||||
(cond ((> pt bot)
|
||||
(goto-char bot))
|
||||
((= pt bol)
|
||||
(or (and doom--last-backward-pt
|
||||
(= (line-number-at-pos doom--last-backward-pt)
|
||||
(line-number-at-pos pt)))
|
||||
(setq doom--last-backward-pt nil))
|
||||
(goto-char (or doom--last-backward-pt bot))
|
||||
(setq doom--last-backward-pt nil))
|
||||
((<= pt bot)
|
||||
(setq doom--last-backward-pt pt)
|
||||
(goto-char bol))))))
|
||||
|
||||
(defvar doom--last-forward-pt nil)
|
||||
;;;###autoload
|
||||
(defun doom/forward-to-last-non-comment-or-eol (&optional point)
|
||||
"Jumps between the last non-blank, non-comment character in the line and the
|
||||
true end of the line. The opposite of `doom/backward-to-bol-or-indent'."
|
||||
(interactive "^d")
|
||||
(let ((pt (or point (point))))
|
||||
(cl-destructuring-bind (_bol _bot eot eol)
|
||||
(doom--bol-bot-eot-eol pt)
|
||||
(cond ((< pt eot)
|
||||
(goto-char eot))
|
||||
((= pt eol)
|
||||
(goto-char (or doom--last-forward-pt eot))
|
||||
(setq doom--last-forward-pt nil))
|
||||
((>= pt eot)
|
||||
(setq doom--last-backward-pt pt)
|
||||
(goto-char eol))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/backward-kill-to-bol-and-indent ()
|
||||
"Kill line to the first non-blank character. If invoked again afterwards, kill
|
||||
line to beginning of line. Same as `evil-delete-back-to-indentation'."
|
||||
(interactive)
|
||||
(let ((empty-line-p (save-excursion (beginning-of-line)
|
||||
(looking-at-p "[ \t]*$"))))
|
||||
(funcall (if (fboundp 'evil-delete)
|
||||
#'evil-delete
|
||||
#'delete-region)
|
||||
(point-at-bol) (point))
|
||||
(unless empty-line-p
|
||||
(indent-according-to-mode))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-backward-word (arg)
|
||||
"Like `backward-kill-word', but doesn't affect the kill-ring."
|
||||
(interactive "p")
|
||||
(let (kill-ring)
|
||||
(ignore-errors (backward-kill-word arg))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/dumb-indent ()
|
||||
"Inserts a tab character (or spaces x tab-width)."
|
||||
(interactive)
|
||||
(if indent-tabs-mode
|
||||
(insert "\t")
|
||||
(let* ((movement (% (current-column) tab-width))
|
||||
(spaces (if (= 0 movement) tab-width (- tab-width movement))))
|
||||
(insert (make-string spaces ? )))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/dumb-dedent ()
|
||||
"Dedents the current line."
|
||||
(interactive)
|
||||
(if indent-tabs-mode
|
||||
(call-interactively #'backward-delete-char)
|
||||
(unless (bolp)
|
||||
(save-excursion
|
||||
(when (> (current-column) (current-indentation))
|
||||
(back-to-indentation))
|
||||
(let ((movement (% (current-column) tab-width)))
|
||||
(delete-char
|
||||
(- (if (= 0 movement)
|
||||
tab-width
|
||||
(- tab-width movement)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/retab (arg &optional beg end)
|
||||
"Converts tabs-to-spaces or spaces-to-tabs within BEG and END (defaults to
|
||||
buffer start and end, to make indentation consistent. Which it does depends on
|
||||
the value of `indent-tab-mode'.
|
||||
|
||||
If ARG (universal argument) is non-nil, retab the current buffer using the
|
||||
opposite indentation style."
|
||||
(interactive "P\nr")
|
||||
(unless (and beg end)
|
||||
(setq beg (point-min)
|
||||
end (point-max)))
|
||||
(let ((indent-tabs-mode (if arg (not indent-tabs-mode) indent-tabs-mode)))
|
||||
(if indent-tabs-mode
|
||||
(tabify beg end)
|
||||
(untabify beg end))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-trailing-newlines ()
|
||||
"Trim trailing newlines.
|
||||
|
||||
Respects `require-final-newline'."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(delete-blank-lines)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/dos2unix ()
|
||||
"Convert the current buffer to a Unix file encoding."
|
||||
(interactive)
|
||||
(set-buffer-file-coding-system 'undecided-unix nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/unix2dos ()
|
||||
"Convert the current buffer to a DOS file encoding."
|
||||
(interactive)
|
||||
(set-buffer-file-coding-system 'undecided-dos nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-indent-style ()
|
||||
"Switch between tabs and spaces indentation style in the current buffer."
|
||||
(interactive)
|
||||
(setq indent-tabs-mode (not indent-tabs-mode))
|
||||
(message "Indent style changed to %s" (if indent-tabs-mode "tabs" "spaces")))
|
||||
|
||||
(defvar editorconfig-lisp-use-default-indent)
|
||||
;;;###autoload
|
||||
(defun doom/set-indent-width (width)
|
||||
"Change the indentation size to WIDTH of the current buffer.
|
||||
|
||||
The effectiveness of this command is significantly improved if you have
|
||||
editorconfig or dtrt-indent installed."
|
||||
(interactive
|
||||
(list (if (integerp current-prefix-arg)
|
||||
current-prefix-arg
|
||||
(read-number "New indent size: "))))
|
||||
(setq tab-width width)
|
||||
(setq-local standard-indent width)
|
||||
(when (boundp 'evil-shift-width)
|
||||
(setq evil-shift-width width))
|
||||
(cond ((require 'editorconfig nil t)
|
||||
(let (editorconfig-lisp-use-default-indent)
|
||||
(editorconfig-set-indentation nil width)))
|
||||
((require 'dtrt-indent nil t)
|
||||
(when-let (vars (nth 2 (assq major-mode dtrt-indent-hook-mapping-list)))
|
||||
(dolist (var (doom-enlist vars))
|
||||
(doom-log "Updated %s = %d" var width)
|
||||
(set var width)))))
|
||||
(message "Changed indentation to %d" width))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-enable-delete-trailing-whitespace-h ()
|
||||
"Enables the automatic deletion of trailing whitespaces upon file save.
|
||||
|
||||
i.e. enables `ws-butler-mode' in the current buffer."
|
||||
(ws-butler-mode +1))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-delete-trailing-whitespace-h ()
|
||||
"Disables the automatic deletion of trailing whitespaces upon file save.
|
||||
|
||||
i.e. disables `ws-butler-mode' in the current buffer."
|
||||
(ws-butler-mode -1))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-enable-show-trailing-whitespace-h ()
|
||||
"Enable `show-trailing-whitespace' in the current buffer."
|
||||
(setq-local show-trailing-whitespace t))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-show-trailing-whitespace-h ()
|
||||
"Disable `show-trailing-whitespace' in the current buffer."
|
||||
(setq-local show-trailing-whitespace nil))
|
||||
109
lisp/lib/themes.el
Normal file
109
lisp/lib/themes.el
Normal file
|
|
@ -0,0 +1,109 @@
|
|||
;;; lisp/lib/themes.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload
|
||||
(defconst doom-customize-theme-hook nil)
|
||||
|
||||
(add-hook! 'doom-load-theme-hook
|
||||
(defun doom-apply-customized-faces-h ()
|
||||
"Run `doom-customize-theme-hook'."
|
||||
(run-hooks 'doom-customize-theme-hook)))
|
||||
|
||||
(defun doom--custom-theme-set-face (spec)
|
||||
(cond ((listp (car spec))
|
||||
(cl-loop for face in (car spec)
|
||||
collect
|
||||
(car (doom--custom-theme-set-face (cons face (cdr spec))))))
|
||||
((keywordp (cadr spec))
|
||||
`((,(car spec) ((t ,(cdr spec))))))
|
||||
(`((,(car spec) ,(cdr spec))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro custom-theme-set-faces! (theme &rest specs)
|
||||
"Apply a list of face SPECS as user customizations for THEME.
|
||||
|
||||
THEME can be a single symbol or list thereof. If nil, apply these settings to
|
||||
all themes. It will apply to all themes once they are loaded."
|
||||
(declare (indent defun))
|
||||
(let ((fn (gensym "doom--customize-themes-h-")))
|
||||
`(progn
|
||||
(defun ,fn ()
|
||||
(let (custom--inhibit-theme-enable)
|
||||
(dolist (theme (doom-enlist (or ,theme 'user)))
|
||||
(when (or (eq theme 'user)
|
||||
(custom-theme-enabled-p theme))
|
||||
(apply #'custom-theme-set-faces theme
|
||||
(mapcan #'doom--custom-theme-set-face
|
||||
(list ,@specs)))))))
|
||||
;; Apply the changes immediately if the user is using the default theme
|
||||
;; or the theme has already loaded. This allows you to evaluate these
|
||||
;; macros on the fly and customize your faces iteratively.
|
||||
(when (or (get 'doom-theme 'previous-themes)
|
||||
(null doom-theme))
|
||||
(funcall #',fn))
|
||||
;; FIXME Prevent clobbering this on-the-fly
|
||||
(add-hook 'doom-customize-theme-hook #',fn 100))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro custom-set-faces! (&rest specs)
|
||||
"Apply a list of face SPECS as user customizations.
|
||||
|
||||
This is a convenience macro alternative to `custom-set-face' which allows for a
|
||||
simplified face format, and takes care of load order issues, so you can use
|
||||
doom-themes' API without worry."
|
||||
(declare (indent defun))
|
||||
`(custom-theme-set-faces! 'user ,@specs))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/reload-theme ()
|
||||
"Reload the current Emacs theme."
|
||||
(interactive)
|
||||
(unless doom-theme
|
||||
(user-error "No theme is active"))
|
||||
(let ((themes (copy-sequence custom-enabled-themes)))
|
||||
(mapc #'disable-theme custom-enabled-themes)
|
||||
(let (doom-load-theme-hook)
|
||||
(mapc #'enable-theme (reverse themes)))
|
||||
(doom-run-hooks 'doom-load-theme-hook)
|
||||
(doom/reload-font)
|
||||
(message "%s %s"
|
||||
(propertize
|
||||
(format "Reloaded %d theme%s:"
|
||||
(length themes)
|
||||
(if (cdr themes) "s" ""))
|
||||
'face 'bold)
|
||||
(mapconcat #'prin1-to-string themes ", "))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-theme-face-attribute (theme face attribute &optional recursive)
|
||||
"Read a FACE's ATTRIBUTE for a loaded THEME.
|
||||
|
||||
This is different from `face-attribute', which reads the attribute of an active
|
||||
face for the current theme, but an active theme can change (or fail to load) in
|
||||
non-interactive or frame-less sessions."
|
||||
(let* ((spec
|
||||
(cl-loop for (type f _ spec) in (get theme 'theme-settings)
|
||||
if (and (eq type 'theme-face) (eq face f))
|
||||
return spec))
|
||||
(spec
|
||||
(letf! ((defun window-system (_frame) 'x)
|
||||
(defun display-color-cells (_frame) 257)
|
||||
(defun frame-parameter (frame parameter)
|
||||
(pcase parameter
|
||||
(`display-type 'color)
|
||||
(`background-mode 'dark)
|
||||
(_ (funcall frame-parameter frame parameter))))
|
||||
(#'display-supports-face-attributes-p #'always))
|
||||
(face-spec-choose spec)))
|
||||
(inherit (if recursive (plist-get spec :inherit)))
|
||||
(value (if (plist-member spec attribute)
|
||||
(plist-get spec attribute)
|
||||
'unspecified)))
|
||||
(when (and inherit (not (eq inherit 'unspecified)))
|
||||
(letf! (defun face-attribute (face attribute &optional _frame inherit)
|
||||
(doom-theme-face-attribute theme face attribute inherit))
|
||||
(setq value (face-attribute-merged-with attribute value inherit))))
|
||||
value))
|
||||
246
lisp/lib/ui.el
Normal file
246
lisp/lib/ui.el
Normal file
|
|
@ -0,0 +1,246 @@
|
|||
;;; lisp/lib/ui.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Public library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-resize-window (window new-size &optional horizontal force-p)
|
||||
"Resize a window to NEW-SIZE. If HORIZONTAL, do it width-wise.
|
||||
If FORCE-P is omitted when `window-size-fixed' is non-nil, resizing will fail."
|
||||
(with-selected-window (or window (selected-window))
|
||||
(let ((window-size-fixed (unless force-p window-size-fixed)))
|
||||
(enlarge-window (- new-size (if horizontal (window-width) (window-height)))
|
||||
horizontal))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-quit-p (&optional prompt)
|
||||
"Prompt the user for confirmation when killing Emacs.
|
||||
|
||||
Returns t if it is safe to kill this session. Does not prompt if no real buffers
|
||||
are open."
|
||||
(or (not (ignore-errors (doom-real-buffer-list)))
|
||||
(yes-or-no-p (format "%s" (or prompt "Really quit Emacs?")))
|
||||
(ignore (message "Aborted"))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Advice
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-recenter-a (&rest _)
|
||||
"Generic advice for recentering window (typically :after other functions)."
|
||||
(recenter))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-preserve-window-position-a (fn &rest args)
|
||||
"Generic advice for preserving cursor position on screen after scrolling."
|
||||
(let ((row (cdr (posn-col-row (posn-at-point)))))
|
||||
(prog1 (apply fn args)
|
||||
(save-excursion
|
||||
(let ((target-row (- (line-number-at-pos) row)))
|
||||
(unless (< target-row 0)
|
||||
(evil-scroll-line-to-top target-row)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-shut-up-a (fn &rest args)
|
||||
"Generic advisor for silencing noisy functions.
|
||||
|
||||
In interactive Emacs, this just inhibits messages from appearing in the
|
||||
minibuffer. They are still logged to *Messages*.
|
||||
|
||||
In tty Emacs, messages are suppressed completely."
|
||||
(quiet! (apply fn args)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-apply-ansi-color-to-compilation-buffer-h ()
|
||||
"Applies ansi codes to the compilation buffers. Meant for
|
||||
`compilation-filter-hook'."
|
||||
(with-silent-modifications
|
||||
(ansi-color-apply-on-region compilation-filter-start (point))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-show-paren-mode-h ()
|
||||
"Turn off `show-paren-mode' buffer-locally."
|
||||
(setq-local show-paren-mode nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-enable-line-numbers-h ()
|
||||
(display-line-numbers-mode +1))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-disable-line-numbers-h ()
|
||||
(display-line-numbers-mode -1))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-line-numbers ()
|
||||
"Toggle line numbers.
|
||||
|
||||
Cycles through regular, relative and no line numbers. The order depends on what
|
||||
`display-line-numbers-type' is set to. If you're using Emacs 26+, and
|
||||
visual-line-mode is on, this skips relative and uses visual instead.
|
||||
|
||||
See `display-line-numbers' for what these values mean."
|
||||
(interactive)
|
||||
(defvar doom--line-number-style display-line-numbers-type)
|
||||
(let* ((styles `(t ,(if visual-line-mode 'visual 'relative) nil))
|
||||
(order (cons display-line-numbers-type (remq display-line-numbers-type styles)))
|
||||
(queue (memq doom--line-number-style order))
|
||||
(next (if (= (length queue) 1)
|
||||
(car order)
|
||||
(car (cdr queue)))))
|
||||
(setq doom--line-number-style next)
|
||||
(setq display-line-numbers next)
|
||||
(message "Switched to %s line numbers"
|
||||
(pcase next
|
||||
(`t "normal")
|
||||
(`nil "disabled")
|
||||
(_ (symbol-name next))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/delete-frame-with-prompt ()
|
||||
"Delete the current frame, but ask for confirmation if it isn't empty."
|
||||
(interactive)
|
||||
(if (cdr (frame-list))
|
||||
(when (doom-quit-p "Close frame?")
|
||||
(delete-frame))
|
||||
(save-buffers-kill-emacs)))
|
||||
|
||||
|
||||
(defun doom--enlargened-forget-last-wconf-h ()
|
||||
(set-frame-parameter nil 'doom--maximize-last-wconf nil)
|
||||
(set-frame-parameter nil 'doom--enlargen-last-wconf nil)
|
||||
(remove-hook 'doom-switch-window-hook #'doom--enlargened-forget-last-wconf-h))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-maximize-buffer (&optional arg)
|
||||
"Close other windows to focus on this one.
|
||||
Use `winner-undo' to undo this. Alternatively, use `doom/window-enlargen'."
|
||||
(interactive "P")
|
||||
(when (and (bound-and-true-p +popup-mode)
|
||||
(+popup-window-p))
|
||||
(+popup/raise (selected-window)))
|
||||
(delete-other-windows))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-enlargen (&optional arg)
|
||||
"Enlargen the current window (i.e. shrinks others) so you can focus on it.
|
||||
Use `winner-undo' to undo this. Alternatively, use
|
||||
`doom/window-maximize-buffer'."
|
||||
(interactive "P")
|
||||
(let* ((window (selected-window))
|
||||
(dedicated-p (window-dedicated-p window))
|
||||
(preserved-p (window-parameter window 'window-preserved-size))
|
||||
(ignore-window-parameters t)
|
||||
(window-resize-pixelwise nil)
|
||||
(frame-resize-pixelwise nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(when dedicated-p
|
||||
(set-window-dedicated-p window nil))
|
||||
(when preserved-p
|
||||
(set-window-parameter window 'window-preserved-size nil))
|
||||
(maximize-window window))
|
||||
(set-window-dedicated-p window dedicated-p)
|
||||
(when preserved-p
|
||||
(set-window-parameter window 'window-preserved-size preserved-p)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-maximize-horizontally ()
|
||||
"Delete all windows to the left and right of the current window."
|
||||
(interactive)
|
||||
(require 'windmove)
|
||||
(save-excursion
|
||||
(while (ignore-errors (windmove-left)) (delete-window))
|
||||
(while (ignore-errors (windmove-right)) (delete-window))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/window-maximize-vertically ()
|
||||
"Delete all windows above and below the current window."
|
||||
(interactive)
|
||||
(require 'windmove)
|
||||
(save-excursion
|
||||
(while (ignore-errors (windmove-up)) (delete-window))
|
||||
(while (ignore-errors (windmove-down)) (delete-window))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/set-frame-opacity (opacity)
|
||||
"Interactively change the current frame's opacity.
|
||||
|
||||
OPACITY is an integer between 0 to 100, inclusive."
|
||||
(interactive
|
||||
(list (read-number "Opacity (0-100): "
|
||||
(or (frame-parameter nil 'alpha)
|
||||
100))))
|
||||
(set-frame-parameter nil 'alpha opacity))
|
||||
|
||||
(defvar doom--narrowed-base-buffer nil)
|
||||
;;;###autoload
|
||||
(defun doom/narrow-buffer-indirectly (beg end)
|
||||
"Restrict editing in this buffer to the current region, indirectly.
|
||||
|
||||
This recursively creates indirect clones of the current buffer so that the
|
||||
narrowing doesn't affect other windows displaying the same buffer. Call
|
||||
`doom/widen-indirectly-narrowed-buffer' to undo it (incrementally).
|
||||
|
||||
Inspired from http://demonastery.org/2013/04/emacs-evil-narrow-region/"
|
||||
(interactive
|
||||
(list (or (bound-and-true-p evil-visual-beginning) (region-beginning))
|
||||
(or (bound-and-true-p evil-visual-end) (region-end))))
|
||||
(unless (region-active-p)
|
||||
(setq beg (line-beginning-position)
|
||||
end (line-end-position)))
|
||||
(deactivate-mark)
|
||||
(let ((orig-buffer (current-buffer)))
|
||||
(with-current-buffer (switch-to-buffer (clone-indirect-buffer nil nil))
|
||||
(narrow-to-region beg end)
|
||||
(setq-local doom--narrowed-base-buffer orig-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/widen-indirectly-narrowed-buffer (&optional arg)
|
||||
"Widens narrowed buffers.
|
||||
|
||||
This command will incrementally kill indirect buffers (under the assumption they
|
||||
were created by `doom/narrow-buffer-indirectly') and switch to their base
|
||||
buffer.
|
||||
|
||||
If ARG, then kill all indirect buffers, return the base buffer and widen it.
|
||||
|
||||
If the current buffer is not an indirect buffer, it is `widen'ed."
|
||||
(interactive "P")
|
||||
(unless (buffer-narrowed-p)
|
||||
(user-error "Buffer isn't narrowed"))
|
||||
(let ((orig-buffer (current-buffer))
|
||||
(base-buffer doom--narrowed-base-buffer))
|
||||
(cond ((or (not base-buffer)
|
||||
(not (buffer-live-p base-buffer)))
|
||||
(widen))
|
||||
(arg
|
||||
(let ((buffer orig-buffer)
|
||||
(buffers-to-kill (list orig-buffer)))
|
||||
(while (setq buffer (buffer-local-value 'doom--narrowed-base-buffer buffer))
|
||||
(push buffer buffers-to-kill))
|
||||
(switch-to-buffer (buffer-base-buffer))
|
||||
(mapc #'kill-buffer (remove (current-buffer) buffers-to-kill))))
|
||||
((switch-to-buffer base-buffer)
|
||||
(kill-buffer orig-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-narrow-buffer (beg end)
|
||||
"Narrow the buffer to BEG END. If narrowed, widen it."
|
||||
(interactive
|
||||
(list (or (bound-and-true-p evil-visual-beginning) (region-beginning))
|
||||
(or (bound-and-true-p evil-visual-end) (region-end))))
|
||||
(if (buffer-narrowed-p)
|
||||
(widen)
|
||||
(unless (region-active-p)
|
||||
(setq beg (line-beginning-position)
|
||||
end (line-end-position)))
|
||||
(narrow-to-region beg end)))
|
||||
Loading…
Add table
Add a link
Reference in a new issue