refactor: Move user config into modules/

modules/home/users/crumb/emacs/lib/syd-prelude.el

@@ -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)