msyds/sydnix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Move user config into modules/

Browse Source
This commit is contained in:
Madeleine Sydney
2025-03-13 11:14:32 -06:00
parent 257f011a99
commit fb3299d89c
85 changed files with 597 additions and 542 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
modules/home/users/crumb/emacs/lib/clj-lib.el Normal file
View File

@@ -0,0 +1,15 @@
;;; clj-lib.el -*- lexical-binding: t; -*-
(require 'dash)
(defmacro clj-condp (pred expr &rest clauses)
"TODO: Very unfinished."
(declare (indent defun))
(unless (symbolp pred)
(signal 'wrong-type-argument `(symbolp ,pred)))
(let ((expr* (gensym "expr")))
`(let ((,expr* ,expr))
(cond ,@(mapcar (lambda (x) `((,pred ,expr ,(car x)) ,(nth 1 x)))
clauses)))))
(provide 'clj-lib)

150
modules/home/users/crumb/emacs/lib/syd-buffers.el Normal file
View File

@@ -0,0 +1,150 @@
;;; syd-buffers.el -*- lexical-binding: t; -*-
(require 'syd-prelude)
(syd-define-stub
syd/kill-all-buffers
:desc "Kill all buffers. See `doom/kill-all-buffers'."
:interactive t)
(syd-define-stub
syd/kill-other-buffers
:desc "Kill other buffers. See `doom/kill-other-buffers'."
:interactive t)
(syd-define-stub
syd/kill-burried-buffers
:desc "Kill burried buffers. See `doom/kill-burried-buffers'."
:interactive t)
(syd-define-stub
syd/save-buffer-as-root
:desc "Sudo save buffer as root. See `doom/sudo-save-buffer'"
:interactive t)
(defvar syd-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).")
(defun syd-fallback-buffer ()
"Returns the fallback buffer, creating it if necessary. By default this is the
scratch buffer. See `syd-fallback-buffer-name' to change this."
(let (buffer-list-update-hook)
(get-buffer-create syd-fallback-buffer-name)))
(defvar-local syd-real-buffer-p nil
"If non-nil, this buffer should be considered real no matter what. See
`syd-real-buffer-p' for more information.")
(defun syd-special-buffer-p (buf)
"Returns non-nil if BUF's name starts and ends with an *."
(char-equal ?* (aref (buffer-name buf) 0)))
(defun syd-non-file-visiting-buffer-p (buf)
(with-current-buffer buf
(if buffer-file-name t nil)))
(defvar syd-unreal-buffer-functions
'(minibufferp syd-special-buffer-p syd-non-file-visiting-buffer-p)
"A list of predicate functions run to determine if a buffer is *not* real,
unlike `syd-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 `syd-real-buffer-p' for more information.")
(defun syd-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))
(defvar syd-real-buffer-functions
'(syd-dired-buffer-p)
"A list of predicate functions run to determine if a buffer is real, unlike
`syd-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 `syd-real-buffer-p' for more information.")
(defun syd-temp-buffer-p (buf)
"Returns non-nil if BUF is temporary."
(char-equal ?\s (aref (buffer-name buf) 0)))
(defun syd-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. 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 `syd-real-buffer-p'
variable OR
2. Any function in `syd-real-buffer-functions' returns non-nil OR
3. None of the functions in `syd-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 (syd-temp-buffer-p buf))
(or (buffer-local-value 'syd-real-buffer-p buf)
(run-hook-with-args-until-success 'syd-real-buffer-functions buf)
(not (run-hook-with-args-until-success 'syd-unreal-buffer-functions buf))))))
(defun syd-unreal-buffer-p (buffer-or-name)
"Return t if BUFFER-OR-NAME is an 'unreal' buffer.
See `syd-real-buffer-p' for details on what that means."
(not (syd-real-buffer-p buffer-or-name)))
(defun syd-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 (syd-unreal-buffer-p (window-buffer))
(previous-buffer)
(when (syd-unreal-buffer-p (window-buffer))
(switch-to-buffer (syd-fallback-buffer)))))))
;;;###autoload
(defun syd-set-buffer-realness (buffer realness)
(with-current-buffer buffer
(setq syd-real-buffer-p realness)))
;;;###autoload
(defun syd-mark-buffer-as-real ()
(syd-set-buffer-realness (current-buffer) t))
(defun syd-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)
(syd-fixup-windows (cl-remove-if-not #'window-live-p windows))))
(defun syd/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)))
(syd-kill-buffer-fixup-windows buffer))
(provide 'syd-buffers)

17
modules/home/users/crumb/emacs/lib/syd-constants.el Normal file
View File

@@ -0,0 +1,17 @@
;;; syd-constants.el -*- lexical-binding: t; -*-
(defvar syd-data-dir
(or (getenv "EMACS_DATA_DIR")
(error "Need $EMACS_DATA_DIR"))
"Directory analogous to XDG_DATA_HOME for miscellaneous Emacs things. Sydnix
will wipe this on boot!")
(defvar syd-cache-dir
(or (getenv "EMACS_CACHE_DIR")
(error "Need $EMACS_CACHE_DIR"))
"Directory analogous to XDG_CACHE_HOME for miscellaneous Emacs things. Sydnix
will not usually wipe this on boot; /however/ it is still free to clear this
directory at any time.")
(provide 'syd-constants)
;;; syd-constants.el ends here

161
modules/home/users/crumb/emacs/lib/syd-file.el Normal file
View File

@@ -0,0 +1,161 @@
;;; syd-file.el -*- lexical-binding: t; -*-
(require 'syd-prelude)
(require 'syd-buffers)
(require 'cl-lib)
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'tramp))
(syd-define-stub
syd/copy-this-file
:desc "Copy current file. See `doom/copy-this-file'."
:interactive t)
(defun syd-files--update-refs (&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))
(dolist (default-directory toplevels)
(magit-refresh))
(when (bound-and-true-p save-place-mode)
(save-place-forget-unreadable-files))))))
(defun syd/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 (and path (abbreviate-file-name path))))
(unless 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')
(syd/kill-this-buffer-in-all-windows buf t)
(syd-files--update-refs path)
(message "Deleted %S" short-path)))))
(syd-define-stub
syd/move-this-file
:desc "Move current file. See `doom/move-this-file'."
:interactive t)
(defun syd-find-file-in (root)
(interactive (list (read-directory-name
"Find file in: " default-directory nil t)))
;; HACK: To avoid reimplementation, we pretend `root' is a project and
;; delegate the work to project.el.
(syd-with-project-root root
(project-find-file)))
(syd-define-stub
syd/yank-buffer-path
:desc "Yank buffer path."
:interactive t)
(defun syd/find-file-in-emacs-user-directory ()
(interactive)
(unless (file-directory-p user-emacs-directory)
(user-error "`user-emacs-directory' doesn't exist! (%s)"
(abbreviate-file-name user-emacs-directory)))
(let ((default-directory user-emacs-directory))
(call-interactively #'find-file)))
(defun syd-switch-to-emacs-user-directory ()
"Switch project to `user-emacs-directory' via `project-switch-project'."
(interactive)
(require 'syd-project)
(if (file-directory-p user-emacs-directory)
(syd-with-project-root user-emacs-directory
(project-switch-project user-emacs-directory))
(user-error "`user-emacs-directory' (%s) does not exist or is not a directory!"
(abbreviate-file-name user-emacs-directory))))
(syd-define-stub
syd/open-this-file-as-root
:desc "Open current file as root. See `doom/sudo-this-file'."
:interactive t)
(syd-define-stub
syd/find-file-as-root
:desc "Open current file as root. See `doom/sudo-this-file'."
:interactive t)
(defun syd--make-syncthing-merge-finalise-hook (file-name conflict-file-name)
(lambda ()
(let ((merge-result-file (read-file-name
(format "Write merge to (default: %s):"
file-name)
nil file-name))
(delete-conflict-p (yes-or-no-p (format "Delete conflict file? (%s)"
conflict-file-name)))))
(when merge-result-file
(with-current-buffer ediff-buffer-C
(set-visited-file-name merge-result-file)
(save-buffer))
(kill-buffer ediff-buffer-C))
(when delete-conflict-p
(kill-buffer (find-buffer-visiting conflict-file-name))
(delete-file conflict-file-name))))
(defun syd--read-syncthing-conflict-file (&optional directory)
(let ((conflict-files (directory-files-recursively
(or directory default-directory)
(rx ".sync-conflict-"))))
(completing-read "Conflict file: " conflict-files nil t)))
(defun syd--syncthing-conflict-file-base-name (conflict-file)
(replace-regexp-in-string (rx ".sync-conflict-" (* (not ?.)))
""
conflict-file))
(defun syd-resolve-syncthing-conflict (conflict-file)
(interactive (list (syd--read-syncthing-conflict-file)))
(require 'ediff)
(let* ((base-file (syd--syncthing-conflict-file-base-name conflict-file))
(ediff-after-quit-hook-internal
;; Override Ediff's "save and quit" hook with our own.
(cons (syd--make-syncthing-merge-finalise-hook base-file conflict-file)
(remq #'ediff-write-merge-buffer-and-maybe-kill
(ensure-list ediff-quit-merge-hook)))))
(ediff-merge-files
base-file
conflict-file)))
;;;###autoload
(defun syd-split-tramp-file-name (file-name)
"Split FILE-NAME into (TRAMP-PREFIX . LOCAL-NAME). Returns (nil . FILE-NAME)
if FILE-NAME has no TRAMP prefix."
(if (tramp-tramp-file-p file-name)
(let* ((dissected (tramp-dissect-file-name file-name t))
(localname (tramp-file-name-localname dissected)))
(setf (tramp-file-name-localname dissected) nil)
(cons (tramp-make-tramp-file-name dissected)
localname))
(cons nil file-name)))
(provide 'syd-file)

110
modules/home/users/crumb/emacs/lib/syd-general.el Normal file
View File

@@ -0,0 +1,110 @@
;;; syd-general.el -*- lexical-binding: t; -*-
(use-package general
:custom (general-use-package-emit-autoloads t))
(require 'general)
(defvar syd-leader-key "SPC"
"A prefix key akin to Vim's <Leader>.")
(defvar syd-localleader-key "SPC m"
"A prefix key akin to Vim's <LocalLeader>.")
(defvar syd-alt-leader-key "M-SPC"
"`syd-leader', but for the states specified in `syd-alt-leader-key-states'.
Often, your \"usual\" leader key will be something unavailable in the Insert
state. This key exists as a fallback for when you need your Leader, but must
remain in the Insert state. Substitute \"Insert state\" for your states of
choice with `syd-alt-leader-key-states'.")
(defvar syd-alt-localleader-key "M-SPC m"
"`syd-localleader', but for the states specified in `syd-alt-leader-key-states'.
See `syd-alt-leader-key' for rationale.")
(defvar syd-leader-key-states '(normal visual motion)
"States for which the Leader keys (`syd-leader-key', `syd-localleader-key')
are active.")
(defvar syd-alt-leader-key-states '(emacs insert)
"States for which the alternative Leader keys are active. See
`syd-alt-leader-key' and `syd-alt-localleader-key'.")
(defvar-keymap syd-leader-map
:doc "Leader-prefixed commands")
(defun syd-initialise-leader ()
"Set up the (empty) keymap associated with `syd-leader-key',
`syd-localleader-key', `syd-alt-leader-key', and `syd-alt-localleader-key'."
(require 'evil)
;; Define `syd/leader' as a command corresponding to the prefix map
;; `syd-leader-map'.
(define-prefix-command 'syd/leader 'syd-leader-map)
;; This should help make the Leader key close to universally available.
;; Ideally, *nothing* takes precedence over Leader — it's an incredibly
;; important key!
;; https://github.com/noctuid/evil-guide?tab=readme-ov-file#undoprevent-overridingintercept-maps
;; See `evil-make-overriding-map'.
(define-key syd-leader-map [override-state] 'all)
;; Finally, we shall bind the damned keys. }:)
(let ((map general-override-mode-map))
(evil-define-key* syd-leader-key-states map (kbd syd-leader-key) 'syd/leader)
(evil-define-key* syd-alt-leader-key-states map (kbd syd-alt-leader-key) 'syd/leader))
(general-override-mode 1))
(defvar syd-escape-hook nil
"A hook run when C-g is pressed (or ESC in Evil's normal state).
More specifically, when `syd/escape' is pressed. If any hook returns non-nil,
all hooks after it are ignored.")
;;
;;; Universal, non-nuclear escape
;; `keyboard-quit' is too much of a nuclear option. I want ESC/C-g to
;; do-what-I-mean. It serves four purposes (in order):
;;
;; 1. Quit active states; e.g. highlights, searches, snippets, iedit,
;; multiple-cursors, recording macros, etc.
;; 2. Close popup windows remotely (if it is allowed to)
;; 3. Refresh buffer indicators, like diff-hl and flycheck
;; 4. Or fall back to `keyboard-quit'
;;
;; And it should do these things incrementally, rather than all at once. And it
;; shouldn't interfere with recording macros or the minibuffer. This may
;; require you press ESC/C-g two or three times on some occasions to reach
;; `keyboard-quit', but this is much more intuitive.
(defun syd/escape (&optional interactive)
"Run `syd-escape-hook'."
(interactive (list 'interactive))
(let ((inhibit-quit t))
(cond ((minibuffer-window-active-p (minibuffer-window))
;; quit the minibuffer if open.
(when interactive
(setq this-command 'abort-recursive-edit))
(abort-recursive-edit))
;; Run all escape hooks. If any returns non-nil, then stop there.
((run-hook-with-args-until-success 'syd-escape-hook))
;; don't abort macros
((or defining-kbd-macro executing-kbd-macro) nil)
;; Back to the default
((unwind-protect (keyboard-quit)
(when interactive
(setq this-command 'keyboard-quit)))))))
(with-eval-after-load 'eldoc
(eldoc-add-command 'syd/escape))
;; In normal state, pressing escape should run `syd-escape-hook'.
(with-eval-after-load 'evil
(defun evil-syd/escape-a (&rest _)
"Call `syd/escape' if `evil-force-normal-state' is called interactively."
(when (called-interactively-p 'any)
(call-interactively #'syd/escape)))
(advice-add #'evil-force-normal-state
:after #'evil-syd/escape-a))
(provide 'syd-general)

258
modules/home/users/crumb/emacs/lib/syd-handle-eval.el Normal file
View File

@@ -0,0 +1,258 @@
;;; syd-handle-eval.el -*- lexical-binding: t; -*-
(defvar syd-eval-runners '())
;; Remove ellipsis when printing sexps in message buffer.
(setq eval-expression-print-length nil
eval-expression-print-level nil)
(set-popup-rule!
"*eval*"
:size 0.2)
;; Packages
(use-package quickrun
:defer t)
(use-package eros
:hook (emacs-lisp-mode . eros-mode))
;; (with-eval-after-load quickrun
;; (setq quickrun-focus-p nil)
;; (set-popup-rule! "^\\*quickrun" :size 0.3 :ttl 0)
;; (defadvice! +eval--quickrun-fix-evil-visual-region-a ()
;; "Make `quickrun-replace-region' recognize evil visual selections."
;; :override #'quickrun--outputter-replace-region
;; (let ((output (buffer-substring-no-properties (point-min) (point-max))))
;; (with-current-buffer quickrun--original-buffer
;; (cl-destructuring-bind (beg . end)
;; ;; Because `deactivate-mark', the function, was used in
;; ;; `quickrun--region-command-common' instead of `deactivate-mark',
;; ;; the variable, the selection is disabled by this point.
;; (if (bound-and-true-p evil-local-mode)
;; (cons evil-visual-beginning evil-visual-end)
;; (cons (region-beginning) (region-end)))
;; (delete-region beg end)
;; (insert output))
;; (setq quickrun-option-outputter quickrun--original-outputter))))
;; (defadvice! +eval--quickrun-auto-close-a (&rest _)
;; "Silently re-create the quickrun popup when re-evaluating."
;; :before '(quickrun quickrun-region)
;; (when-let (win (get-buffer-window quickrun--buffer-name))
;; (let ((inhibit-message t))
;; (quickrun--kill-running-process)
;; (message ""))
;; (delete-window win)))
;; (add-hook! 'quickrun-after-run-hook
;; (defun +eval-quickrun-shrink-window-h ()
;; "Shrink the quickrun output window once code evaluation is complete."
;; (when-let (win (get-buffer-window quickrun--buffer-name))
;; (with-selected-window (get-buffer-window quickrun--buffer-name)
;; (let ((ignore-window-parameters t))
;; (shrink-window-if-larger-than-buffer)))))
;; (defun +eval-quickrun-scroll-to-bof-h ()
;; "Ensures window is scrolled to BOF on invocation."
;; (when-let (win (get-buffer-window quickrun--buffer-name))
;; (with-selected-window win
;; (goto-char (point-min))))))
;; ;; Display evaluation results in an overlay at the end of the current line. If
;; ;; the output is more than `+eval-popup-min-lines' (4) lines long, it is
;; ;; displayed in a popup.
;; (when (modulep! +overlay)
;; (defadvice! +eval--show-output-in-overlay-a (fn)
;; :filter-return #'quickrun--make-sentinel
;; (lambda (process event)
;; (funcall fn process event)
;; (with-current-buffer quickrun--buffer-name
;; (when (> (buffer-size) 0)
;; (+eval-display-results
;; (string-trim (buffer-string))
;; quickrun--original-buffer)))))
;; ;; Suppress quickrun's popup window because we're using an overlay instead.
;; (defadvice! +eval--inhibit-quickrun-popup-a (buf cb)
;; :override #'quickrun--pop-to-buffer
;; (setq quickrun--original-buffer (current-buffer))
;; (save-window-excursion
;; (with-current-buffer (pop-to-buffer buf)
;; (setq quickrun-option-outputter #'ignore)
;; (funcall cb))))
;; ;; HACK Without this, `+eval--inhibit-quickrun-popup-a' throws a
;; ;; window-live-p error because no window exists to be recentered!
;; (advice-add #'quickrun--recenter :override #'ignore)))
;;;###autoload
(cl-defun syd-eval-region-as-major-mode
(beg end &key (runner-major-mode major-mode))
"Evaluate a region between BEG and END and display the output.
Evaluate as in RUNNER-MAJOR-MODE. If RUNNER-MAJOR-MODE is nil, use major-mode
of the buffer instead."
(if-let* ((runner (alist-get runner-major-mode syd-eval-runners)))
(funcall runner beg end)
(and (require 'quickrun nil t)
(let ((quickrun-option-cmdkey
(quickrun--command-key
(buffer-file-name (buffer-base-buffer)))))
(quickrun-region beg end)))))
;;;###autoload
(defun syd-eval-region (beg end)
(interactive "r")
;; (message "syd: %s" (pp-to-string
;; (buffer-substring-no-properties (syd-region-beginning)
;; (syd-region-end))))
;; (message "r: %s" (pp-to-string (buffer-substring-no-properties beg end)))
(syd-eval-region-as-major-mode beg end))
(with-eval-after-load 'evil
(evil-define-operator syd-eval-operator (beg end)
"Evaluate selection."
:move-point nil
(interactive "<r>")
(syd-eval-region beg end))
(general-def
:states 'normal
"gR" #'syd-eval-buffer)
(general-def
:states '(normal visual)
"gr" #'syd-eval-operator))
;;;###autoload
(defun set-eval-handler! (modes command)
"Define a code evaluator for major mode MODES with `quickrun'.
MODES can be list of major mode symbols, or a single one.
1. If MODE is a string and COMMAND is the string, MODE is a file regexp and
COMMAND is a string key for an entry in `quickrun-file-alist'.
2. If MODE is not a string and COMMAND is a string, MODE is a major-mode symbol
and COMMAND is a key (for `quickrun--language-alist'), and will be registered
in `quickrun--major-mode-alist'.
3. If MODE is not a string and COMMAND is an alist, see `quickrun-add-command':
(quickrun-add-command MODE COMMAND :mode MODE).
4. If MODE is not a string and COMMANd is a symbol, add it to
`syd-eval-runners', which is used by `syd-eval-region'."
(declare (indent defun))
(dolist (mode (ensure-list modes))
(cond ((symbolp command)
(push (cons mode command) syd-eval-runners))
((stringp command)
(with-eval-after-load 'quickrun
(push (cons mode command)
(if (stringp mode)
quickrun-file-alist
quickrun--major-mode-alist))))
((listp command)
(with-eval-after-load 'quickrun
(quickrun-add-command
(or (cdr (assq mode quickrun--major-mode-alist))
(string-remove-suffix "-mode" (symbol-name mode)))
command :mode mode))))))
(defvar syd-eval-overlay-max-lines 4
"The maximum number of lines allowed to be displayed in an eval overlay; any
more and a popup buffer will be used instead.")
;;;###autoload
(defun syd-eval-display-results-in-popup (output)
"Display OUTPUT in a popup buffer."
(let ((output-buffer (get-buffer-create "*eval*"))
(origin (selected-window)))
(with-current-buffer output-buffer
(setq-local scroll-margin 0)
(erase-buffer)
(insert output)
(goto-char (point-min))
;; (if (fboundp '+word-wrap-mode)
;; (+word-wrap-mode +1)
;; (visual-line-mode +1))
)
(when-let* ((win (display-buffer output-buffer)))
;; (fit-window-to-buffer
;; win (/ (frame-height) 2)
;; nil (/ (frame-width) 2))
)
(select-window origin)
output-buffer))
;;;###autoload
(defun syd-eval-buffer ()
"Evaluate the entire buffer."
(interactive)
(syd-eval-region (point-min) (point-max)))
;;;###autoload
(defun syd-eval-buffer-or-region ()
"Evaluate the region if it is active, or the entire buffer, or not."
(if (use-region-p)
(call-interactively #'syd-eval-region)
(call-interactively #'syd-eval-buffer)))
;;;###autoload
(cl-defun syd-eval-display-results-in-overlay (output &key source-buffer)
"Display OUTPUT in a floating overlay next to the cursor."
(require 'eros)
(with-current-buffer (or source-buffer (current-buffer))
(let* ((this-command #'syd-eval/buffer-or-region)
(prefix eros-eval-result-prefix)
(lines (split-string output "\n"))
(prefixlen (length prefix))
(len (+ (apply #'max (mapcar #'length lines))
prefixlen))
(next-line? (or (cdr lines)
(< (- (window-width)
(save-excursion (goto-char (line-end-position))
(- (current-column)
(window-hscroll))))
len)))
(pad (if next-line?
(+ (window-hscroll) prefixlen)
0))
eros-overlays-use-font-lock)
(eros--make-result-overlay
(concat (make-string (max 0 (- pad prefixlen)) ?\s)
prefix
(string-join lines (concat hard-newline (make-string pad ?\s))))
:where (if next-line?
(line-beginning-position 2)
(line-end-position))
:duration eros-eval-result-duration
:format "%s"))))
;;;###autoload
(cl-defun syd-eval-display-results (output &key source-buffer force-popup)
"Display OUTPUT in an overlay, or if it's too long, a popup buffer."
(if (or force-popup
;; EROS is used to display overlays. Without it, just use a popup.
(not (require 'eros nil t))
(with-temp-buffer
(insert output)
(or
;; Too tall!
(<= syd-eval-overlay-max-lines
(count-lines (point-min) (point-max)))
;; Too wide!
(<= (window-width)
(string-width
(buffer-substring (point-min)
(save-excursion
(goto-char (point-min))
(line-end-position))))))))
(syd-eval-display-results-in-popup output)
(syd-eval-display-results-in-overlay output :source-buffer source-buffer))
output)
(provide 'syd-handle-eval)

130
modules/home/users/crumb/emacs/lib/syd-handle-lookup.el Normal file
View File

@@ -0,0 +1,130 @@
;;; syd-handle-lookup.el -*- lexical-binding: t; -*-
(require 'syd-text)
(use-package better-jumper)
(require 'better-jumper)
(defvar syd-lookup-online-documentation-backends
`(("Kagi" . "https://kagi.com/search?q=%s")
("DuckDuckGo" . "https://duckduckgo.com/?q=%s")
("Nixpkgs" . "https://search.nixos.org/packages?query=%s")
("Hackage" . "https://hackage.haskell.org/packages/search?terms=%s")
("The Free Dictionary" . "https://www.thefreedictionary.com/%s")
("The Free Thesaurus" . "https://www.freethesaurus.com/%s"))
"A list of pairs (NAME . BACKEND) describing the various backends
`syd-lookup-online-documentation' may delegate to.
NAME is a string used when speaking to the user about BACKEND.
If BACKEND is an interactive command, it will be called interactively.
If BACKEND is a procedure, it will be called with the search string as the lone
argument.
If BACKEND is a string, the user's browser will be opened to the URL returned by
(format BACKEND QUERY), where QUERY is the appropriately-encoded search
string.")
(defvar syd-lookup-documentation-handlers '(syd-lookup-online-documentation)
"A list of lookup handlers used to find documentation. A lookup handler
receives an identifier, and is expected to return nil on failure, and non-nil on
success. When a handler returns a marker, the marker will be jumped to.")
(defun syd-lookup--prompt-for-online-backend ()
(assoc-string
(completing-read "Search with: "
(mapcar #'car syd-lookup-online-documentation-backends)
nil
t)
syd-lookup-online-documentation-backends))
(cl-defun syd-lookup--call-online-backend (backend &key query-string)
(pcase-let ((`(,name . ,backend-fn) backend))
(cond ((functionp backend-fn) (if (commandp backend-fn)
(call-interactively backend-fn)
(funcall backend-fn query-string)))
((stringp backend-fn)
(browse-url (format backend-fn
(url-encode-url
(read-string (format "Search %s for: "
name)
query-string)))))
(t (signal 'wrong-type-argument `("backend" ,backend-fn))))))
;;;###autoload
(cl-defun syd-lookup-online-documentation (backend &key query-string)
(interactive (list (syd-lookup--prompt-for-online-backend)
:query-string (when (use-region-p)
(syd-thing-at-point-or-region))))
(syd-lookup--call-online-backend backend
:query-string query-string))
;;;###autoload
(defun syd-lookup-documentation (identifier)
"Try to find documentation on IDENTIFIER, and "
(interactive (list (syd-thing-at-point-or-region)))
(or (syd-lookup--jump-to 'documentation identifier
:display-fn #'pop-to-buffer)
(user-error "Couldn't find documentation on %S"
(substring-no-properties identifier))))
(defvar syd-lookup--handlers-by-category
'((documentation . syd-lookup-documentation-handlers)))
(cl-defun syd-lookup--jump-to
(category identifier &key (display-fn #'switch-to-buffer))
(let* ((handlers (alist-get category syd-lookup--handlers-by-category))
(origin (point-marker))
;; TODO: If called with a prefix argument, prompt the user to select a
;; handler.
(result (run-hook-wrapped handlers #'syd-lookup--run-handler
identifier origin)))
(unwind-protect
(when (cond ((null result)
(message "No lookup handler could find %S" identifier)
nil)
((markerp result)
(funcall display-fn (marker-buffer result))
(goto-char result)
result)
(result))
(with-current-buffer (marker-buffer origin)
(better-jumper-set-jump (marker-position origin)))
result))
(set-marker origin nil)))
(defun syd-lookup--run-handler (handler identifier origin)
(condition-case-unless-debug e
(let ((wconf (current-window-configuration))
(result (condition-case-unless-debug e
(if (commandp handler)
(call-interactively handler)
(funcall handler identifier))
(error
(message "Lookup handler %S threw an error: %s" handler e)
'fail))))
(cond ((eq result 'fail)
(set-window-configuration wconf)
nil)
((or (get handler 'syd-lookup-async)
(eq result 'deferred)))
((bufferp result)
(with-current-buffer result
(point-marker)))
((or result
(null origin)
(/= (point-marker) origin))
(prog1 (point-marker)
(set-window-configuration wconf)))))
((error user-error)
(message "Lookup handler %S: %s" handler e)
nil)))
(general-def
:states 'normal
"K" #'syd-lookup-documentation)
(provide 'syd-handle-lookup)
;;; syd-handle-lookup.el ends here

267
modules/home/users/crumb/emacs/lib/syd-handle-repl.el Normal file
View File

@@ -0,0 +1,267 @@
;;; syd-handle-repl.el -*- lexical-binding: t; -*-
(eval-when-compile (require 'cl-lib))
(require 'syd-prelude)
(require 'syd-project)
(syd-add-hook 'on-init-ui-hook
(defun syd--set-popup-rules-for-repls-h ()
(require 'doom-popup)
(set-popup-rule!
(lambda (bufname _)
(when (boundp 'syd-repl-mode)
(buffer-local-value 'syd-repl-mode (get-buffer bufname))))
:ttl (lambda (buf)
(unless (plist-get syd-repl-plist :persist)
(when-let (process (get-buffer-process buf))
(set-process-query-on-exit-flag process nil)
(kill-process process)
(kill-buffer buf))))
:size 0.25
:quit nil)))
;;; State & settings
(defvar +syd-major-mode-repl-alist '()
"TODO: An alist pairing major-modes (symbols) with plists describing REPLs.")
(defvar +syd-repl-buffers (make-hash-table :test 'equal)
"A hashmap mapping pairs (MAJOR-MODE . PROJECT-ROOT) to their corresponding
buffers. Indeed, this implies a single REPL per language per project. Is this
limitation worth overcoming? I'm not sure! I've yet to butt heads with it.")
(defvar-local syd-repl-plist nil
"A plist describing the repl associated with the current buffer.
This is little more than a cache. Its value can almost always be equivalently
derived from `+syd-major-mode-repl-alist'.")
(defun set-repl-handler! (modes command &rest plist)
"Defines a REPL for MODES.
MODES is either a single major mode symbol or a list of them. COMMAND is a
function that creates and returns the REPL buffer.
COMMAND can either be a function that takes no arguments, or an interactive
command that will be called interactively. COMMANDS must return either the repl
buffer or a function that takes no arguments and returns the repl buffer.
PLIST is a property list that map special attributes to this repl. These are
recognized:
:persist BOOL
If non-nil, this REPL won't be killed when its window is closed.
:send-region FUNC
A function that accepts a BEG and END, and sends the contents of the region
to the REPL. Defaults to `+eval/send-region-to-repl'.
:send-buffer FUNC
A function of no arguments that sends the contents of the buffer to the REPL.
Defaults to `+eval/region', which will run the :send-region specified function
or `+eval/send-region-to-repl'."
(declare (indent defun))
(dolist (mode (ensure-list modes))
(setf (alist-get mode +syd-major-mode-repl-alist)
(cons command plist))))
;;; Repls
;;;###autoload
(define-minor-mode syd-repl-mode
"A minor mode for repl buffers. One use is to universally customise the
display of all repl buffers."
:after-hook (format "syd-repl-mode after %s" (current-buffer)))
(defun syd--repl-from-major-mode ()
"TODO:"
(pcase-let ((`(_ ,fn . ,plist) (assq major-mode +syd-major-mode-repl-alist)))
(list fn plist)))
(defun syd--clean-repl-buffers ()
"Remove any key/value pairs from `+syd-repl-buffers' whose values involve a
not-alive buffer."
(maphash (lambda (repl-key buffer)
(unless (buffer-live-p buffer)
(remhash repl-key +syd-repl-buffers)))
+syd-repl-buffers))
(defun syd--get-repl-key ()
(cons major-mode (syd-project-root)))
(defun syd--goto-end-of-repl ()
"Try to move point to the last comint prompt or the end of the buffer."
(unless (or (derived-mode-p 'term-mode)
(eq (current-local-map) (bound-and-true-p term-raw-map)))
(goto-char (if (and (derived-mode-p 'comint-mode)
(cdr comint-last-prompt))
(cdr comint-last-prompt)
(point-max)))))
(cl-defun syd--call-repl-handler (repl-handler &key plist repl-key)
"Spawn a new repl buffer using REPL-HANDLER. REPL-HANDLER's return value will
be returned.
If REPL-HANDLER fails to return a buffer, this `syd--call-repl-handler' will
throw an error. `syd-repl-mode' will be enabled in the new buffer, and the
buffer will be cached in `+syd-repl-buffers'.
REPL-HANDLER will be called interactively if supported."
(let ((repl-buffer (save-window-excursion
(if (commandp repl-handler)
(call-interactively repl-handler)
(funcall repl-handler)))))
(unless repl-buffer
(error "REPL handler %S couldn't open the REPL buffer" fn))
(unless (bufferp repl-buffer)
(error "REPL handler %S failed to return a buffer" fn))
(with-current-buffer repl-buffer
;; It is important that `syd-repl-mode' is enabled before the buffer is
;; displayed by `display-fn'.
(syd-repl-mode 1)
(when plist
;; Cache the plist at `syd-repl-plist'.
(setq syd-repl-plist plist)))
(puthash repl-key repl-buffer +syd-repl-buffers)
repl-buffer))
;; #+begin_src dot :file /tmp/repl.svg :results file graphics
;; digraph {
;; bgcolor="transparent"
;;
;; node [
;; fillcolor=gray95
;; color=black
;; shape=record
;; ]
;;
;; "Start" [shape=diamond]
;; "Start" -> x1
;; x1 [label="Is the user currently in the repl buffer,\nOR has a repl handler NOT been provided?"]
;;
;; x1 -> x2 [label="Yes"]
;; x1 -> x3 [label="No"]
;; x2 [label="Find entry in +syd-repl-buffers;\nis it a live buffer?"]
;; x2 -> x4 [label="Yes"]
;; x4 [label="Call display-fn on the\n+syd-repl-buffers entry, and use the result"]
;; x2 -> x5 [label="No"]
;; x5 [label="Call the provided repl-handler. Ensure it returns\na valid buffer, and pass the resultto display-fn.\nSet the plist, enable repl mode, update\n+syd-repl-buffers. Use the buffer returned by display-fn"]
;; x3 [label="Use entry found in +syd-repl-buffers"]
;; }
;; #+end_src
(cl-defun syd--ensure-in-repl-buffer
(&key repl-handler plist (display-fn #'get-buffer-create))
"Display the repl buffer associated with the current major mode and project.
A repl buffer will be created (using REPL-HANDLER) if necessary.
If an active repl buffer is found in `+syd-repl-buffers', it will be displayed
by the given DISPLAY-FN.
PLIST is a plist of repl-specific options."
(syd--clean-repl-buffers)
(let* ((repl-key (syd--get-repl-key))
(maybe-repl-buffer (gethash repl-key +syd-repl-buffers)))
(cl-check-type maybe-repl-buffer (or buffer null))
(let ((repl-buffer
(if (or (eq maybe-repl-buffer (current-buffer))
(null repl-handler))
;; * If the current buffer is the repl buffer, we can be sure
;; that it is not nil and can be returned as-is.
;; * If we were not given a repl-handler, there's nothing else we
;; can do. Return what was found in `+syd-repl-buffers', and
;; hope it's the right thing.
maybe-repl-buffer
;; If the repl buffer found in `+syd-repl-buffers' is live and
;; well, we can return that. If not, we're going to have to spawn
;; a new repl buffer with `repl-handler' and `display-fn'.
(if (buffer-live-p maybe-repl-buffer)
(funcall display-fn maybe-repl-buffer)
(funcall display-fn
(syd--call-repl-handler repl-handler
:plist plist
:repl-key repl-key))))))
(when (bufferp repl-buffer)
(with-current-buffer repl-buffer
(syd--goto-end-of-repl))
repl-buffer))))
(defun syd--known-repls ()
"Return a list of all known mode-repl pairs, each as a two-element list.
More precisely, the return value is a list of mode-repl pairs, where each
mode-repl pair is a two-element list (MAJOR-MODE HANDLER) where MAJOR-MODE is a
symbol, and HANDLER is a (possibly interactive) procedure.
See also: `+syd-major-mode-repl-alist'."
(mapcar (lambda (xs) (list (car xs) (cadr xs)))
+syd-major-mode-repl-alist))
(defun syd--pretty-mode-name (mode)
"Convert MODE (a symbol or string) into a string appropriate for human
presentation."
(let ((mode* (if (symbolp mode) (symbol-name mode) mode)))
(if (not (string-match "^\\([a-z-]+\\)-mode$" mode*))
(error "Given string/symbol is not a major mode: %s" mode*)
(string-join (split-string
(capitalize (match-string-no-properties 1 mode*))
"-")
" "))))
(defun syd-prompt-for-repl ()
"Prompt the user for a repl to open. Returns the chosen repl-handler
function."
;; REVIEW: Doom scans all interned symbols for anything that looks like
;; "open-XXXX-repl." Is this worth doing?
(let* ((repls (mapcar (lambda (xs)
(pcase-let ((`(,mode ,fn) xs))
(list (syd--pretty-mode-name mode) fn)))
(syd--known-repls)))
(choice (or (completing-read "Open a REPL for: "
(mapcar #'car repls))
(user-error "Aborting"))))
(cadr (assoc choice repls))))
(defun syd-send-region-to-repl (beg end)
(interactive "r")
(let ((selection (buffer-substring-no-properties beg end))
(buffer (syd--ensure-in-repl-buffer)))))
(cl-defun +syd-open-repl (&key prompt-p display-fn)
"TODO: Open a repl via DISPLAY-FN. When PROMPT-P, the user will be
unconditionally prompted for a repl choice.
If Evil-mode is active, insert state will be enabled."
(pcase-let* ((`(,major-mode-fn ,plist) (syd--repl-from-major-mode))
(repl-handler (if (or prompt-p (not major-mode-fn))
(syd-prompt-for-repl)
major-mode-fn))
(region (when (use-region-p)
(buffer-substring-no-properties (region-beginning)
(region-end)))))
(unless (commandp repl-handler)
(error "Couldn't find a REPL for %s" major-mode))
(with-current-buffer (syd--ensure-in-repl-buffer :repl-handler repl-handler
:plist plist
:display-fn display-fn)
;; Start the user in insert mode at the end of the input line.
(when (bound-and-true-p evil-mode)
(call-interactively #'evil-append-line))
(when region
(insert region))
t)))
;;;###autoload
(defun +syd/open-repl-other-window (prompt-p)
"Like `+syd-open-repl', but opens in a different window. The repl
corresponding to the current major mode and project will be opened, unless a
prefix argument is given, in which case the user will be prompted for a repl."
(interactive "P")
(+syd-open-repl :prompt-p prompt-p
:display-fn #'pop-to-buffer))
(provide 'syd-handle-repl)

134
modules/home/users/crumb/emacs/lib/syd-kanagawa.el Normal file
View File

@@ -0,0 +1,134 @@
;;; syd-kanagawa.el -*- lexical-binding: t; -*-
;;; Rationale: I need direct access to the Kanagawa palette, which kanagawa.el
;;; does not provide.
(defvar syd-kanagawa-palette (make-hash-table :test 'eq
:size 130))
(defvar syd-kanagawa-palette-list
'((sumi-ink-0 "#16161D")
(sumi-ink-1 "#181820")
(sumi-ink-2 "#1a1a22")
(sumi-ink-3 "#1F1F28")
(sumi-ink-4 "#2A2A37")
(sumi-ink-5 "#363646")
(sumi-ink-6 "#54546D") ; fg
;; Popup and Floats
(wave-blue-1 "#223249")
(wave-blue-2 "#2D4F67")
;; Diff and Git
(winter-green "#2B3328")
(winter-yellow "#49443C")
(winter-red "#43242B")
(winter-blue "#252535")
(autumn-green "#76946A")
(autumn-red "#C34043")
(autumn-yellow "#DCA561")
;; Diag
(samurai-red "#E82424")
(ronin-yellow "#FF9E3B")
(wave-aqua-1 "#6A9589")
(dragon-blue "#658594")
;; Fg and Comments
(old-white "#C8C093")
(fuji-white "#DCD7BA")
(fuji-gray "#727169")
(oni-violet "#957FB8")
(oni-violet-2 "#b8b4d0")
(crystal-blue "#7E9CD8")
(spring-violet-1 "#938AA9")
(spring-violet-2 "#9CABCA")
(spring-blue "#7FB4CA")
(light-blue "#A3D4D5")
(wave-aqua-2 "#7AA89F") ;; improve lightness: desaturated greenish Aqua
(spring-green "#98BB6C")
(boat-yellow-1 "#938056")
(boat-yellow-2 "#C0A36E")
(carp-yellow "#E6C384")
(sakura-pink "#D27E99")
(wave-red "#E46876")
(peach-red "#FF5D62")
(surimi-orange "#FFA066")
(katana-gray "#717C7C")
(dragon-black-0 "#0d0c0c")
(dragon-black-1 "#12120f")
(dragon-black-2 "#1D1C19")
(dragon-black-3 "#181616")
(dragon-black-4 "#282727")
(dragon-black-5 "#393836")
(dragon-black-6 "#625e5a")
(dragon-white "#c5c9c5")
(dragon-green "#87a987")
(dragon-green-2 "#8a9a7b")
(dragon-pink "#a292a3")
(dragon-orange "#b6927b")
(dragon-orange-2 "#b98d7b")
(dragon-gray "#a6a69c")
(dragon-gray1 "#9e9b93")
(dragon-gray-3 "#7a8382")
(dragon-blue-2 "#8ba4b0")
(dragon-violet "#8992a7")
(dragon-red "#c4746e")
(dragon-aqua "#8ea4a2")
(dragon-ash "#737c73")
(dragon-teal "#949fb5")
(dragon-yellow "#c4b28a")
(lotus-ink-1 "#545464")
(lotus-ink-2 "#43436c")
(lotus-gray "#dcd7ba")
(lotus-gray-2 "#716e61")
(lotus-gray-3 "#8a8980")
(lotus-white-0 "#d5cea3")
(lotus-white-1 "#dcd5ac")
(lotus-white-2 "#e5ddb0")
(lotus-white-3 "#f2ecbc")
(lotus-white-4 "#e7dba0")
(lotus-white-5 "#e4d794")
(lotus-violet-1 "#a09cac")
(lotus-violet-2 "#766b90")
(lotus-violet-3 "#c9cbd1")
(lotus-violet-4 "#624c83")
(lotus-blue-1 "#c7d7e0")
(lotus-blue-2 "#b5cbd2")
(lotus-blue-3 "#9fb5c9")
(lotus-blue-4 "#4d699b")
(lotus-blue-5 "#5d57a3")
(lotus-green "#6f894e")
(lotus-green-2 "#6e915f")
(lotus-green-3 "#b7d0ae")
(lotus-pink "#b35b79")
(lotus-orange "#cc6d00")
(lotus-orange2 "#e98a00")
(lotus-yellow "#77713f")
(lotus-yellow-2 "#836f4a")
(lotus-yellow-3 "#de9800")
(lotus-yellow-4 "#f9d791")
(lotus-red "#c84053")
(lotus-red-2 "#d7474b")
(lotus-red-3 "#e82424")
(lotus-red-4 "#d9a594")
(lotus-aqua "#597b75")
(lotus-aqua-2 "#5e857a")
(lotus-teal-1 "#4e8ca2")
(lotus-teal-2 "#6693bf")
(lotus-teal-3 "#5a7785")
(lotus-cyan "#d7e3d8")))
(cl-loop for (k v) in syd-kanagawa-palette-list
do (puthash k v syd-kanagawa-palette))
(defun syd-kanagawa-get (k)
(gethash k syd-kanagawa-palette nil))
(provide 'syd-kanagawa)

512
modules/home/users/crumb/emacs/lib/syd-lisp-lib.el Normal file
View File

@@ -0,0 +1,512 @@
;;; syd-lisp-lib.el -*- lexical-binding: t; -*-
(require 'general)
(require 'clj-lib)
(use-package smartparens
:defer t)
(use-package evil-surround
:defer t)
;; Include various lispy symbols as word constituents.
(dolist (c '(?- ?_ ?? ?! ?+ ?* ?/ ?: ?> ?< ?= ?&))
(modify-syntax-entry c "w" lisp-data-mode-syntax-table))
;;;###autoload
(defvar-keymap syd-lisp-mode-map
:doc "Keymap for `syd-lisp-mode'.")
;;;###autoload
(define-minor-mode syd-lisp-mode
"A minor mode for editing lispy languages."
:keymap syd-lisp-mode-map)
;;;###autoload
(defun syd-wrap-sexp (char)
"Wrap the sexp at point (using `smartparens') with the pair corresponding to
CHAR (using `evil-surround'). Unlike other `evil-surround' operations, the
point will be preserved and the wrapped region will be re-indented."
(interactive (evil-surround-input-char))
(sp-get (sp-get-thing)
(save-excursion
(evil-surround-region :beg :end 'inclusive char)
(indent-region :beg :end))))
;;;###autoload
(evil-define-motion syd-get-enclosing-sexp ()
"Like `sp-get-enclosing-sexp', but with a slightly different meaning of
\"enclosing sexp\" that matches Vim-sexp's"
(or (let ((sexp-at-point (sp-get-sexp)))
(sp-get sexp-at-point
(when (or (and :beg (= (point) :beg))
(and :end (= (point) (- :end 1))))
sexp-at-point)))
(let ((sp-enclosing-sexp (sp-get-enclosing-sexp)))
(sp-get sp-enclosing-sexp
(when :beg
sp-enclosing-sexp)))))
;;;###autoload
(evil-define-motion syd-backward-up-sexp (count)
"Move point to the opening bracket of the enclosing sexp. The precise meaning
of \"enclosing sexp\" differs slightly from that used by Smartparens for the
sake of a more Vim-like feel inspired by vim-sexp."
:type exclusive
(dotimes (_ (or count 1))
;; REVIEW: Is there a better way to do this? I'm slightly uncomfortable
;; calling two different `sp-get-*' functions.
(or (sp-get (sp-get-sexp)
(when (and :end (= (point) (- :end 1)))
(goto-char :beg)))
(sp-get (sp-get-enclosing-sexp)
(when :beg
(goto-char :beg))))))
;;;###autoload
(evil-define-motion syd-forward-up-sexp (&optional count)
"Move point to the closing bracket of the enclosing sexp. See
`syd-backward-up-sexp'."
:type exclusive
(dotimes (_ (or count 1))
(or (sp-get (sp-get-sexp)
(when (and :beg (= (point) :beg))
(goto-char (- :end 1))))
(sp-get (sp-get-enclosing-sexp)
(when :end
(if (= (point) (- :end 1))
(sp-get (save-excursion (forward-char)
(sp-get-enclosing-sexp))
(when :end
(goto-char (- :end 1))))
(goto-char (- :end 1))))))))
;;;###autoload
(defun syd-get-top-level-sexp ()
"Get the top-level sexp enclosing point. Destructure with `sp-get'.'"
;; The end position returned by `bounds-of-thing-at-point' includes an
;; unpredictable amount of trailing whitespace, so we discard it and compute
;; our own figure.
(let ((original-point (point)))
(-when-let ((beg . _) (bounds-of-thing-at-point 'defun))
(save-excursion
(goto-char beg)
;; We can trust Smarparents to get the desired end position.
(-let* ((top-level-sexp (sp-get-sexp))
((_ . end) (sp-get top-level-sexp (cons :beg :end))))
;; If the sexp is behind point, we aren't interested in it; find one
;; /ahead/ of point.
(if (< original-point end)
top-level-sexp
(goto-char end)
(sp-next-sexp)
(sp-get-sexp)))))))
;;;###autoload
(defun syd-get-top-level-sexp-and-attached-comment-bounds ()
"Get the bounds of top-level sexp enclosing point and the \"attached\"
comment, if there is one. Returns nil or a pair (BEG . END)."
(-when-let ((beg . end) (sp-get (syd-get-top-level-sexp) (cons :beg :end)))
(let ((attached-comment-beg (save-excursion
(goto-char beg)
(syd-sexp--backward-attached-comment))))
(cons (or attached-comment-beg beg)
end))))
(evil-define-motion syd-forward-defun (count)
:jump t
(sp-get (syd-get-top-level-sexp)
(goto-char :beg)
(dotimes (_ (or count 1))
(sp-next-sexp))))
(defvar syd-sexp-cleanup-operators '(evil-delete)
"When `syd-evil-a-defun' is used in combination with one of these operators,
some cleanup will be performed.")
;; FIXME(#12): Comments should only attach to the *immediately* following sexp.
;; Consider the following snippet:
;;
;; ;; Call the continuation if non-nil. Wraps the return value in a singleton
;; ;; list for "affine" use with unquote-splicing.
;; (let ((call-cont (lambda (cont arg)
;; (if cont
;; (list (funcall cont arg))
;; nil)))
;; names)
;; ...)
;;
;; The curreny behaviour of `syd-sexp--backward-attached-comment' considers the
;; comment to be attached to both the (let ...) form, as well as the ((call-cont
;; ...)) form and the (call-cont ...) form. Not good!
(defun syd-sexp--backward-attached-comment ()
"Assuming point is on the opening delimiter of a sexp, move point backward to
the beginning of the \"attached\" comment."
(let ((sexp-line (line-number-at-pos))
(sexp-column (current-column)))
(-when-let ((beg . _end) (save-excursion
(goto-line (- sexp-line 1))
(evil-forward-char sexp-column t)
(sp-get-comment-bounds)))
(goto-char beg))))
;;;###autoload
(evil-define-text-object syd-evil-a-defun (count _beg _end _type)
"Selects the enclosing top-level sexp. With a COUNT of N, that many
consequtive top-level sexps will be selected. TODO: Special care will be taken
to clean up whitespace following certain operators."
:type inclusive
(when (< count 0)
(user-error "TODO: Negative count"))
(-let ((cleanup-p (memq evil-this-operator syd-sexp-cleanup-operators))
((beg-0 . end-0)
(syd-get-top-level-sexp-and-attached-comment-bounds)))
(if (or (null count) (= count 1))
(list beg-0 end-0)
(goto-char end-0)
(dotimes (_ (- count 1))
(sp-next-sexp))
(sp-get (sp-get-sexp)
(list beg-0 :end)))))
;; IDEA: How about the inner-defun text object selects the defun /without/ the
;; comment? Is that more useful, or less? I can't think of the last time Ive
;; needed the top-level sexp without the brackets.
;;;###autoload
(evil-define-text-object syd-evil-inner-defun (_count _beg _end _type)
"Select the *content* of the enclosing top-level sexp, i.e. without the
delimiters."
:type inclusive
(sp-get (syd-get-top-level-sexp)
(list (+ :beg 1)
(- :end 1))))
(defun syd-sexp--forward-trailing-whitespace (sexp)
"Move point to the end of the whitespace trailing after SEXP."
(goto-char (sp-get sexp :end))
(skip-chars-forward "[:blank:]")
(when (= (char-after) ?\n)
(forward-char)
(skip-chars-forward "[:blank:]")))
(defun syd-sexp--backward-leading-whitespace (sexp)
"Move point to the beginning of the whitespace preceding SEXP."
(goto-char (sp-get sexp :beg))
(skip-chars-backward "[:blank:]")
(when (= (char-before) ?\n)
(backward-char)
(skip-chars-backward "[:blank:]")))
;;;###autoload
(evil-define-text-object syd-evil-a-form (count _beg _end _type)
(let* ((cleanup-p (memq evil-this-operator syd-sexp-cleanup-operators))
(sexp (syd-get-enclosing-sexp)))
(if cleanup-p
(save-excursion
(goto-char (sp-get sexp :beg))
(if (syd-sexp--looking-at-last-p)
(progn (syd-sexp--backward-leading-whitespace sexp)
(list (point) (sp-get sexp :end)))
(syd-sexp--forward-trailing-whitespace sexp)
(list (sp-get sexp :beg) (point))))
(sp-get sexp (list :beg :end)))))
;;;###autoload
(evil-define-text-object syd-evil-inner-form (count _beg _end _type)
(sp-get (syd-get-enclosing-sexp)
(list (+ :beg 1) (- :end 1))))
;;;###autoload
(evil-define-command syd-open-sexp-below ()
"Insert a newline with appropriate indentation after the enclosing sexp. A
sexp-wise analogue to Evil's line-wise `evil-open-below'."
:suppress-operator t
(evil-with-single-undo
;; We want to add an additional blank line when operating at the top level.
;; Instead of parsing upward until we can no longer find an enclosing sexp,
;; we simply check if the opening bracket is on the first column. This is
;; not very correct, but it's way less work (for myself and the CPU). If we
;; switch to a tree-sitter–based parser, I'd love to switch to the correct
;; algorithm.
(-let* (((beg . end) (sp-get (syd-get-enclosing-sexp) (cons :beg :end)))
(col (save-excursion (goto-char beg) (current-column))))
(goto-char end)
(if (= col 0)
(newline 2)
(newline-and-indent))))
(evil-insert-state 1))
;;;###autoload
(evil-define-command syd-open-sexp-above ()
"Insert a newline with appropriate indentation above the enclosing sexp. A
sexp-wise analogue to Evil's line-wise `evil-open-above'."
:suppress-operator t
(evil-with-single-undo
(let ((beg (sp-get (syd-get-enclosing-sexp) :beg)))
(goto-char beg)
(syd-sexp--backward-attached-comment)
(let ((col (current-column)))
(save-excursion
;; We want to add an additional blank line when operating at the top
;; level. Instead of parsing upward until we can no longer find an
;; enclosing sexp, we simply check if the opening bracket is on the
;; first column. This is not very correct, but it's way less work (for
;; myself and the CPU). If we switch to a tree-sitter–based parser, I'd
;; love to switch to the correct algorithm.
(if (= col 0)
(newline 2)
(newline-and-indent)))
(indent-to col)
(evil-insert-state 1)))))
(defun syd-sexp-get-last-thing ()
(-let (((enclosing-beg . enclosing-end)
(sp-get (syd-get-enclosing-sexp) (cons :beg :end))))
(save-excursion
;; Imperative andy. }:\
(let (thing)
(while (sp-get (syd-get-thing)
(and (< enclosing-beg :beg enclosing-end)
(< enclosing-beg :end enclosing-end))))))))
(defun syd-sexp--looking-at-last-p ()
"Return non-nil if the sexp beginning at point is the last element of its
enclosing sexp."
(save-excursion
(let ((point-0 (point))
(sexp (sp-get-enclosing-sexp)))
(sp-next-sexp)
(if sexp
(or
;; If `sp-next-sexp' moved backwards, `point-0' was the last
;; element.
(<= (point) point-0)
;; If `sp-next-sexp' moved outside of the previously-enclosing
;; sexp, `point-0' was final.
(<= (sp-get sexp :end) (point)))
;; No enclosing sexp — we're looking at a top-level sexp.
(= (point) point-0)))))
(defun syd-sexp--next-thing ()
"Helper for `syd-sexo->'. Find the next thing relative to the sexp assumed to
begin at point, and the region covering the closing delimiters."
(save-excursion
(condition-case err
(cl-loop for relative-height from 0
while (syd-sexp--looking-at-last-p)
do (or (sp-backward-up-sexp)
;; Nothing to slurp!
(signal 'top))
finally return (cons (sp-next-sexp) relative-height))
(top nil))))
(defun syd-sexp--slurp-forward ()
"Slurp forward. Do not call this function directly; see `syd-sexp->'."
;; REVIEW: This is rather unoptimised when used with a count.
(when-let* ((consumer (sp-get-sexp)))
(goto-char (sp-get consumer :beg))
(-if-let ((next-thing . relative-height) (syd-sexp--next-thing))
(progn (goto-char (sp-get consumer :beg-in))
(sp-forward-slurp-sexp (+ 1 relative-height))
(sp-get (sp-get-enclosing-sexp)
(goto-char (- :end 1))))
(user-error "ra"))))
(defun syd-sexp--barf-forward ()
"Barf forward. Do not call this function directly; see `syd-sexp-<'."
(sp-forward-barf-sexp))
;;;###autoload
(evil-define-command syd-sexp-> (&optional count)
(interactive "<c>")
(evil-with-single-undo
(when-let* ((sexp (sp-get-sexp)))
(let ((fn (cond ((= (point) (sp-get sexp (- :end 1)))
#'syd-sexp--slurp-forward))))
(dotimes (_ (or count 1))
(funcall fn))))))
;;;###autoload
(evil-define-command syd-sexp-< (&optional count)
(interactive "<c>")
(evil-with-single-undo
(when-let* ((sexp (sp-get-sexp)))
(let ((fn (cond ((= (point) (sp-get sexp (- :end 1)))
#'syd-sexp--barf-forward))))
(dotimes (_ (or count 1))
(funcall fn))))))
(defun syd-sexp--looking-at-delimiter-p ()
(sp-get (sp-get-sexp)
(and (not (sp-point-in-string-or-comment))
(or (= (point) :beg)
(= (point) (- :end 1))))))
;; REVIEW: It might be neat to, iff the point is already in a comment/string,
;; goto delimiters that are also in comments/strings. For now, let's just
;; ignore comments.
(defun syd-sexp--goto-delimiter (delimiter-type direction count)
(let* ((point-0 (point))
(delimiters (mapcar (clj-condp eq delimiter-type
('opening #'car)
('closing #'cdr))
sp-pair-list))
(delimiter-regexp (rx-to-string `(or ,@delimiters)))
(forward-p (clj-condp eq direction
('forward t)
('backward nil)
(t (error "todo errrrare"))))
(move (lambda ()
;; `forward-p' never changes between calls to `move'; we are
;; doing many more checks than we need to.
(and (condition-case er
(prog1 t (when forward-p
(forward-char)))
(end-of-buffer (throw 'no-move 'no-move)))
(if (if forward-p
(re-search-forward delimiter-regexp nil t)
(re-search-backward delimiter-regexp nil t))
(goto-char (match-beginning 0))
(throw 'no-move 'no-move))))))
;; If `syd-sexp--looking-at-delimiter-p' returns nil, we may be looking at
;; the right string of characters, but we are likely inside of a string,
;; or a comment, or something. If we aren't at a "real" delimiter, move
;; again.
(let ((r (catch 'no-move
(dotimes (_ count)
(while (and (funcall move)
(not (syd-sexp--looking-at-delimiter-p))))))))
(if (eq r 'no-move)
(progn (goto-char point-0)
(user-error "Nowhere to go"))
r))))
(evil-define-motion syd-sexp-forward-opening (count)
(syd-sexp--goto-delimiter 'opening 'forward (or count 1)))
(evil-define-motion syd-sexp-backward-opening (count)
(syd-sexp--goto-delimiter 'opening 'backward (or count 1)))
(evil-define-motion syd-sexp-forward-closing (count)
(syd-sexp--goto-delimiter 'closing 'forward (or count 1)))
(evil-define-motion syd-sexp-backward-closing (count)
(syd-sexp--goto-delimiter 'closing 'backward (or count 1)))
(defun syd-sexp-get-sexp-with-prefix ()
(-when-let* ((thing (sp-get-thing))
;; TODO: Rewrite using :beg-prf
((beg . prefix) (sp-get thing (cons :beg :prefix)))
(prefix-beg (- beg (length prefix))))
;; HACK: Relies on Smartparen's internal representation, which
;; they explicitly recommend against. This could break at any
;; time!
;; Reminder that `plist-put' is an in-place update. }:)
(plist-put thing :beg prefix-beg)
(plist-put thing :prefix "")
(goto-char prefix-beg)
thing))
(evil-define-motion syd-sexp-next (count)
"Like `sp-next-sexp', but prefixes will be considered as part of the sexp."
;; If point is resting on a prefix when `syd-sexp-next' is called,
;; `sp-next-sexp' will move to the beginning of the prefixed form. This is
;; undesirable, as `syd-sexp-next' considers the prefix and the prefixed form
;; to be a single thing. To get around this, we make sure to move point past
;; the prefixed sexp.
(let ((count* (or count 1)))
(when-let* ((_ (<= 0 count*))
(first-prefixed-sexp (syd-sexp-get-sexp-with-prefix)))
(sp-get first-prefixed-sexp
(when (<= :beg (point) :end)
(goto-char :end))))
(let ((current-prefix-arg count*))
(call-interactively #'sp-next-sexp)))
(syd-sexp-get-sexp-with-prefix))
(evil-define-motion syd-sexp-previous (count)
"Like `sp-next-sexp' (as if called with a negative count), but prefixes will
be considered as part of the sexp."
(syd-sexp-next (- (or count 1))))
;;;###autoload
(evil-define-command syd-sexp-insert ()
(evil-with-single-undo
(sp-get (syd-get-enclosing-sexp)
(goto-char (+ 1 :beg))
(save-excursion (insert-char ?\s))
(evil-insert-state 1))))
;;;###autoload
(evil-define-command syd-sexp-append ()
(evil-with-single-undo
(sp-get (syd-get-enclosing-sexp)
(goto-char (- :end 1))
(evil-insert-state 1))))
;; Text objects.
(general-def
:keymaps 'syd-lisp-mode-map
:states '(visual operator)
"ad" #'syd-evil-a-defun
"id" #'syd-evil-inner-defun
"af" #'syd-evil-a-form
"if" #'syd-evil-inner-form)
(general-def
:keymaps 'syd-lisp-mode-map
:states 'insert
";" #'sp-comment)
;; Bind editing commands in normal node, and motion commands in motion
;; mode.
(general-def
:keymaps 'syd-lisp-mode-map
:states 'normal
">" #'syd-sexp->
"<" #'syd-sexp-<
"M-w" #'syd-wrap-sexp
"M-r" #'sp-raise-sexp
"M-c" #'sp-clone-sexp
"M-S" #'sp-split-sexp
"M-J" #'sp-join-sexp
"M-u" #'sp-splice-sexp-killing-backward
"M-U" #'sp-splice-sexp-killing-around
"M-v" #'sp-convolute-sexp
"M-o" #'syd-open-sexp-below
"M-O" #'syd-open-sexp-above
"M-i" #'syd-sexp-insert
"M-a" #'syd-sexp-append)
;; Bind editing commands in normal node, and motion commands in motion
;; mode.
(general-def
:keymaps 'syd-lisp-mode-map
:states 'motion
"C-h" #'sp-backward-up-sexp ; Probably deprecated.
"C-j" #'syd-sexp-next ; Probably deprecated.
"C-k" #'syd-sexp-previous ; Probably deprecated.
"C-l" #'sp-down-sexp ; Probably deprecated.
"M-h" #'sp-backward-up-sexp
"M-j" #'syd-sexp-next
"M-k" #'syd-sexp-previous
"M-l" #'sp-down-sexp
"(" #'syd-backward-up-sexp
")" #'syd-forward-up-sexp
"{" #'syd-sexp-backward-opening
"}" #'syd-sexp-forward-opening
"M-{" #'syd-sexp-backward-closing
"M-}" #'syd-sexp-forward-closing)
(with-eval-after-load 'smartparens
(setq
;; By default, Smartparens will move backwards to the initial character of
;; the enclosing expression, and only move forwards when the point is already
;; on that initial character. This is not expected behaviour for an ex-Vim
;; user.
sp-navigate-interactive-always-progress-point t))
(provide 'syd-lisp-lib)

180
modules/home/users/crumb/emacs/lib/syd-prelude.el Normal file
View File

@@ -0,0 +1,180 @@
;;; syd-prelude.el -*- lexical-binding: t; -*-
(eval-when-compile (require 'cl-lib))
(require 'syd-constants)
(use-package dash)
(require 'dash)
(cl-defmacro syd-define-stub
(name &key (desc "implement me!") interactive)
(let ((todo (format "%s: TODO: %s" name desc)))
`(defun ,name (&rest _)
,@(if interactive (list '(interactive)) nil)
,todo
(error ,todo))))
;; FIXME: When `arg-list' contains nils, things break.
(cl-defun syd-parse-rest-and-keys (arg-list)
"The default behaviour of `cl-defun' makes combining &rest with &keys pretty
useless. This function will partition ARG-LIST by returning a pair (REST
. KEYS), where REST is the list of ARGS that belong to no key-value pair, and
KEYS is an alist of the parsed keywords."
;; Ugh.
(let (parsed-rest parsed-keys)
(cl-loop for (lead lag) on arg-list by (lambda (x) (-drop 2 x))
do (if (keywordp lead)
(push (cons lead lag) parsed-keys)
;; Push in reverse order; we reverse the whole list as a
;; post-processing step.
(push lead parsed-rest)
(when lag
(push lag parsed-rest))))
(cons (reverse parsed-rest) parsed-keys)))
(cl-defun syd-lift-lambdas (&key with-each with-all forms)
;; Call the continuation if non-nil. Wraps the return value in a singleton
;; list for "affine" use with unquote-splicing.
(-let ((call-cont (lambda (cont arg)
(if cont
(list (funcall cont arg))
nil)))
names)
`(progn
,@(cl-loop
for form in forms
appending (cond ((syd-hform-symbol form)
(let ((name (nth 1 form)))
(push name names)
(funcall call-cont with-each name)))
((syd-hform-defun form)
(let ((name (nth 1 form)))
(push name names)
`(,form
,@(funcall call-cont with-each name))))
((syd-hform-lambda form)
(let ((name (gensym "lifted-lambda")))
(push name names)
`((defun ,name (&rest args)
(,form args))
,@(funcall call-cont with-each name))))
(t (error "IDK!"))))
,@(funcall call-cont with-all names))))
(defun syd-hform-symbol (hform)
(and (listp hform)
(= 2 (length hform))
(symbolp (nth 1 hform))
(memq (nth 0 hform) '(quote function))))
(defun syd-hform-defun (hform)
"If HFORM is a defun form, return the defun's name. Otherwise, return nil"
(when-let* ((sym (car-safe hform)))
(and (symbolp sym)
(eq sym 'defun)
(nth 1 hform))))
(defun syd-hform-lambda (hform)
"If HFORM is a lambda, return non-nil."
(when-let* ((sym (car-safe hform)))
(and (symbolp sym)
(eq sym 'lambda))))
(defmacro comment (&rest _)
"Ignore each argument, and expand to nil."
nil)
(defmacro with-transient-after (hook-or-function &rest forms)
(declare (indent defun))
(let ((hook-name (gensym "transient-hook"))
(hook-or-function* (gensym "hook-or-function")))
`(let* ((,hook-or-function* ,hook-or-function))
(defun ,hook-name (&rest _)
"Transient hook defined by `with-transient-after'."
(cond ((functionp ,hook-or-function*)
(advice-remove ,hook-or-function* #',hook-name))
((symbolp ,hook-or-function*)
(remove-hook ,hook-or-function* #',hook-name)))
,@forms)
(cond ((functionp ,hook-or-function*)
(advice-add ,hook-or-function* :before #',hook-name))
((symbolp ,hook-or-function*)
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Setting-Hooks.html#Setting-Hooks-1
(put ',hook-name 'permanent-local-hook t)
(add-hook ,hook-or-function* #',hook-name))))))
(defun syd-plist-put (plist prop new-val)
"Immutably update a single property of PLIST. Like `plist-put', but PLIST is
not mutated; a new plist is returned."
(cl-loop for (prop* old-val) on plist by #'cddr
appending (if (eq prop prop*)
(list prop* new-val)
(list prop* old-val))))
(defmacro syd-add-hook (hooks &rest hforms)
(declare (indent defun))
(syd-lift-lambdas
:forms hforms
:with-all (lambda (fns)
(let ((fn* (gensym "fn"))
(fns* (gensym "fns"))
(hook* (gensym "hook")))
`(let ((,fns* (list ,@(--map `(function ,it)
fns))))
(dolist (,hook* (ensure-list ,hooks))
(dolist (,fn* ,fns*)
(add-hook ,hook* ,fn*))))))))
(defmacro syd-silently (&rest body)
`(error "TODO: syd-silently"))
(defmacro syd-quietly (&rest body)
"Evaluate BODY without generating any output.
This silences calls to `message', `load', `write-region' and anything that
writes to `standard-output'. In interactive sessions this inhibits output to
the echo-area, but not to *Messages*. Return value is that of BODY's final
form."
`(if init-file-debug
(progn ,@body)
,(if noninteractive
`(syd-silently ,@body)
`(let ((inhibit-message t)
(save-silently t))
(prog1 (progn ,@body)
(message ""))))))
(defun syd--parse-defadvice-args (arg-list)
"Parses the docstring and keywords provided to `syd-defadvice'."
(let (docstring
advice)
(when (stringp (car-safe arg-list))
(setq docstring (pop arg-list)))
(while (and (length> arg-list 2)
(keywordp (car arg-list)))
(let ((how (pop arg-list))
(sym (pop arg-list)))
(push (cons how sym) advice)))
;; What's left of `arg-list' is the body of the defun.
(list docstring advice arg-list)))
(defmacro syd-defadvice (name params &rest args)
"Define a function and add it as advice."
(declare (indent defun))
(-let (((docstring advice body) (syd--parse-defadvice-args args)))
`(progn (defun ,name ,params
,@(-some-> docstring list)
,@body)
,@(-map (lambda (arg)
(-let (((how . sym) arg))
`(advice-add ,sym ,how #',name)))
advice))))
(syd-defadvice syd-lsp-install-server-a ()
:override #'lsp-install-server
(user-error (concat "Ignoring a call to `lsp-install-server'"
" — tell the caller to use Nix!")))
(provide 'syd-prelude)

51
modules/home/users/crumb/emacs/lib/syd-project.el Normal file
View File

@@ -0,0 +1,51 @@
;;; syd-project.el -*- lexical-binding: t; -*-
(eval-when-compile (require 'cl-lib))
(require 'project)
(cl-defun syd-project-root (&key (dir default-directory))
"Return the project root of DIR, or nil if DIR belongs to no project."
(when-let* ((project (project-current nil dir)))
(project-root project)))
(defun syd-project-cd ()
"Change the working directory to the root of the current project."
(cd (syd-project-root)))
(define-obsolete-function-alias 'syd-cd-project 'syd-project-cd
"2025-02-20")
(defmacro syd-with-project-root (root &rest body)
"Execute BODY with ROOT recognised as what project.el calls a \"transient
project\"."
(declare (indent defun))
(let ((root* (gensym "root"))
(forget-after-p (gensym "forget-after-p")))
`(let* ((,root* ,root)
(,forget-after-p
(not (member ,root* (project-known-project-roots)))))
(let ((project-find-functions (lambda (_) (cons 'transient ,root*))))
,@body)
(when ,forget-after-p
(project-forget-project ,root*)))))
(defun syd-project-search ()
(interactive)
(require 'syd-file)
;; TODO: Prompt for path project root is not found.
;; TODO: Respect gitignore.
(syd-search-directory (syd-project-root)))
(defun syd-project-root-find-file (file-name)
"Just like `project-root-find-file', but allowing you to select the root
directory itself."
(declare (interactive-only find-file))
(interactive
(list (let ((root (project-root (project-current t))))
(read-file-name
"Find file in root: "
root root (confirm-nonexistent-file-or-buffer)))))
(find-file file-name t))
(provide 'syd-project)
;;; syd-project.el ends here

52
modules/home/users/crumb/emacs/lib/syd-prose.el Normal file
View File

@@ -0,0 +1,52 @@
;;; syd-prose.el -*- lexical-binding: t; -*-
;; Soft-wrap text to not the window edge, but a constant width. Also allows for
;; centering buffer text.
(use-package visual-fill-column
:defer t)
(defun syd-prose-disable-display-line-numbers-mode-h ()
"Disable `display-line-numbers-mode'."
(display-line-numbers-mode -1))
(defun syd-prose-set-visual-fill-column-center ()
"Sets the buffer-local value for `visual-fill-column-center-text'."
(setq-local visual-fill-column-center-text t))
;; Jinx is a fast just-in-time spell-checker for Emacs. Jinx highlights
;; misspelled words in the text of the visible portion of the buffer. For
;; efficiency, Jinx highlights misspellings lazily, recognizes window boundaries
;; and text folding, if any. For example, when unfolding or scrolling, only the
;; newly visible part of the text is checked if it has not been checked
;; before. Each misspelling can be corrected from a list of dictionary words
;; presented as a completion menu.
(use-package jinx
;; Managed by Nix: libenchant dependency.
:straight nil
:commands (jinx-mode jinx-correct jinx-correct-word)
:init (defun syd-jinx--jinx-or-ispell ()
(interactive)
(if (bound-and-true-p jinx-mode)
(call-interactively #'jinx-correct-word)
(call-interactively #'ispell-word)))
:general (:states '(normal visual)
"z =" #'syd-jinx--jinx-or-ispell)
:config
;; Default is "en_US"; fuck that!
(jinx-languages "en" t))
(defvar syd-prose-mode-hook
(list #'syd-prose-set-visual-fill-column-center
#'visual-fill-column-mode
#'visual-line-mode
#'variable-pitch-mode
#'syd-prose-disable-display-line-numbers-mode-h
#'jinx-mode)
"Hooks run for `syd-prose-mode'.")
;;;###autoload
(define-minor-mode syd-prose-mode
"A minor mode for writing prose."
:lighter nil)
(provide 'syd-prose)

55
modules/home/users/crumb/emacs/lib/syd-search.el Executable file
View File

@@ -0,0 +1,55 @@
;;; syd-search.el -*- lexical-binding: t; -*-
(cl-defun syd-search-region (beg end &key initial)
(save-restriction
(narrow-to-region beg end)
(consult-line initial)))
(defun syd-search--escape-regexp (str)
(require 'syd-text)
(replace-regexp-in-string " " "\\\\ "
(syd-pcre-quote str)))
(defun syd-search-buffer (buffer)
"Conduct a text search on BUFFER.
If a selection is active and multi-line, perform a search restricted to that
region.
If a selection is active and not multi-line, use the selection as the initial
input and search the whole buffer for it."
(interactive (list (current-buffer)))
(save-restriction
(let* ((beg (region-beginning))
(end (region-end))
(multiline-p (/= (line-number-at-pos beg)
(line-number-at-pos end))))
(if (and beg end (region-active-p))
(progn (deactivate-mark)
(if multiline-p
(syd-search-region beg end)
;; Treat as a single pattern, not several
;; space-separated patterns.
(consult-line (syd-search--escape-regexp
(buffer-substring-no-properties beg end)))))
(consult-line)))))
;;;###autoload
(defun syd-search-directory (dir)
(interactive (list (read-directory-name
"Search directory: "
default-directory nil t)))
(cond ((executable-find "rg")
(consult-ripgrep dir))
((executable-find "grep")
(message "Couldn't find ripgrep; using grep")
(consult-grep dir))))
;;;###autoload
(defun syd-search-current-directory ()
(interactive)
(syd-search-directory default-directory))
(provide 'syd-search)
;;; syd-search.el ends here

70
modules/home/users/crumb/emacs/lib/syd-strategies-lookup.el Normal file
View File

@@ -0,0 +1,70 @@
;; syd-strategies-lookup.el -*- lexical-binding: t; -*-
(require 'syd-strategies)
(use-package better-jumper)
(require 'better-jumper)
(defun syd-strat--run-lookup-strategy (strategy identifier origin)
"Safely call a lookup STRATEGY. A lookup strategy, if it is not an
interactive command, will be called with the lone argument IDENTIFIER.
Interactive or not, the procedure is expected to return nil on failure. Returns
a marker if STRATEGY returns a buffer or marker, or nil on failure.
Modifications to the window configuration will be discarded if STRATEGY fails to
return a buffer or marker."
(condition-case-unless-debug e
(let ((wconf (current-window-configuration))
(result (condition-case-unless-debug e
(if (commandp strategy)
(call-interactively strategy)
(funcall strategy identifier))
(error
(message "Lookup strategy %S threw an error: %s" strategy e)
'fail))))
(cond ((eq result 'fail)
(set-window-configuration wconf)
nil)
((bufferp result)
(with-current-buffer result
(point-marker)))
((or result
(null origin)
(/= (point-marker) origin))
(prog1 (point-marker)
(set-window-configuration wconf)))))
((error user-error)
(message "Lookup strategy %S: %s" strategy e)
nil)))
(cl-defun syd-strat--lookup-and-jump-to
(strategy-category identifier &key (display-fn #'switch-to-buffer))
(let* ((origin (point-marker))
(strategies (alist-get strategy-category syd-strat--strategies))
;; TODO: If called with a prefix argument, prompt the user to select a
;; strategy.
(result (syd-strat-try-functions-wrapped
#'syd-strat--run-lookup-strategy
strategies identifier origin)))
(unwind-protect
(when (cond ((null result)
(message "No lookup strategy could find %S" identifier)
nil)
((markerp result)
(funcall display-fn (marker-buffer result))
(goto-char result)
result)
(result))
(with-current-buffer (marker-buffer origin)
(better-jumper-set-jump (marker-position origin)))
result))
(set-marker origin nil)))
(defun syd-strat-lookup-documentation (identifier)
(interactive (list (syd-thing-at-point-or-region)))
(syd-strat--lookup-and-jump-to :documentation identifier
:display-fn #'pop-to-buffer))
(defun syd-strat-lookup-definition (identifier)
(interactive (list (syd-thing-at-point-or-region)))
(syd-strat--lookup-and-jump-to :definition identifier))
(provide 'syd-strategies-lookup)

43
modules/home/users/crumb/emacs/lib/syd-strategies.el Normal file
View File

@@ -0,0 +1,43 @@
;; syd-strategies.el -*- lexical-binding: t; -*-
(require 'syd-text)
(comment
"For demonstration:"
(setq syd-strat--strategies
'((:documentation syd-emacs-lisp-lookup-documentation)
(:definition evil-goto-definition))))
;; :documentation : Identifier -> Marker
(defvar-local syd-strat--strategies nil)
(defun syd-strat-try-functions-wrapped (wrapper fns &rest args)
"For each FN in FNS, call WRAPPER with the arguments FN followed by ARGS,
until a FN returns non-nil."
(cl-loop for fn in fns
with r = nil
do (setq r (apply wrapper fn args))
until r
finally return r))
(defun syd-strat--set-strategies (category strategies)
(cl-loop for ref in-ref syd-strat--strategies
until (eq category (car ref))
finally do (pp ref)))
(defun syd-set-strategies (modes &rest args)
(dolist (mode (ensure-list modes))
(let ((hook (intern (format "%s-hook" mode)))
(fn-name (intern (format "syd-strat--init-for-%s-h" mode))))
(unless (cl-evenp (length args))
(signal 'wrong-number-of-arguments args))
;; We use this `defalias' incantation instead of a raw `fset' because the
;; former will properly associate a source location to the definition.
(defalias fn-name
(function
(lambda ()
(cl-loop for (category strategies) on args by (lambda (x) (-drop 2 x))
do (syd-strat--set-strategies category strategies)))))
(add-hook hook fn-name))))
(provide 'syd-strategies)

135
modules/home/users/crumb/emacs/lib/syd-text.el Normal file
View File

@@ -0,0 +1,135 @@
;;; syd-text.el -*- lexical-binding: t; -*-
;;;###autoload
(defun syd-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 syd-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)
(evil-visual-state-p)
(markerp evil-visual-beginning)
(marker-position evil-visual-beginning))
(region-beginning)))
;;;###autoload
(defun syd-region-end ()
"Return end position of selection.
Uses `evil-visual-end' if available."
(declare (side-effect-free t))
(or (and (bound-and-true-p evil-local-mode)
(evil-visual-state-p)
(markerp evil-visual-end)
(marker-position evil-visual-end))
(region-end)))
;;;###autoload
(cl-defun syd-thing-at-point-or-region (&optional thing &key 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)
((syd-region-active-p)
(buffer-substring-no-properties
(syd-region-beginning)
(syd-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.
(let ((backend (xref-find-backend)))
(if (memq 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.
(if-let ((ident (xref-backend-identifier-at-point backend)))
;; REVIEW: `xref-backend-identifier' seems to have some special
;; uses of text properties. Are we sure we want to remove
;; them?
(substring-no-properties ident)))))
(prompt
(read-string (if (stringp prompt) prompt "")))))
;;;###autoload
(defun syd-insert-newline-above (count)
"Insert a blank line below the current line."
(interactive "p")
(dotimes (_ count)
(let ((point-was-at-bol-p (= (current-column) 0)))
(save-excursion
(evil-insert-newline-above))
;; Special case: with `syd-insert-newline-above' is called with point at
;; BOL, the point unexpectedly fails to "stick" to its original position.
(when point-was-at-bol-p
(next-line)))))
;;;###autoload
(defun syd-insert-newline-below (count)
"Insert a blank line below the current line."
(interactive "p")
(dotimes (_ count)
(save-excursion (evil-insert-newline-below))))
;;;###autoload
(defun syd-render-ansi-escape-codes (beg end)
(interactive "r")
(require 'ansi-color)
(if (region-active-p)
(ansi-color-apply-on-region beg end)
(ansi-color-apply-on-region (point-min) (point-max))))
(defun syd-evil-paste (before-p arg &optional register yank-handler)
"Like `evil-paste-after', but a 'C-u' prefix argument will instead act like
':put' (i.e. the register will be pasted onto a new line)."
(if (consp arg)
(evil-ex-put (syd-region-beginning) (syd-region-end)
;; `evil-ex-put' wants a string, but it is immediately
;; converted back to a char. }xP
(and register (string register))
before-p)
(funcall (if before-p #'evil-paste-before #'evil-paste-after)
arg register yank-handler)))
;;;###autoload
(evil-define-command syd-evil-paste-after (arg &optional register yank-handler)
"See `syd-evil-paste'.'"
(interactive "P<x><y>")
(syd-evil-paste nil arg register yank-handler))
;;;###autoload
(evil-define-command syd-evil-paste-before (arg &optional register yank-handler)
"See `syd-evil-paste'.'"
(interactive "P<x><y>")
(syd-evil-paste t arg register yank-handler))
;;;###autoload
(defun syd-pcre-quote (str)
"Like `reqexp-quote', but for PCREs."
(let ((special '(?. ?^ ?$ ?* ?+ ?? ?{ ?\\ ?\[ ?\| ?\())
(quoted nil))
(mapc (lambda (c)
(when (memq c special)
(push ?\\ quoted))
(push c quoted))
str)
(concat (nreverse quoted))))
(provide 'syd-text)

28
modules/home/users/crumb/emacs/lib/syd-window.el Normal file
View File

@@ -0,0 +1,28 @@
;;; syd-window.el -*- lexical-binding: t; -*-
(syd-define-stub
syd/window-swap-left
:desc "Select left window."
:interactive t)
(syd-define-stub
syd/window-swap-down
:desc "Select down window."
:interactive t)
(syd-define-stub
syd/window-swap-up
:desc "Select up window."
:interactive t)
(syd-define-stub
syd/window-swap-right
:desc "Select right window."
:interactive t)
(syd-define-stub
syd/window-maximise
:desc "Maximise window"
:interactive t)
(provide 'syd-window)