134 lines
5.1 KiB
EmacsLisp
134 lines
5.1 KiB
EmacsLisp
;;; syd-prelude.el -*- lexical-binding: t; -*-
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
|
|
(require 'syd-constants)
|
|
|
|
(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 (&rest args)
|
|
;; Call the continuation if non-nil. Wraps the return value in a singleton
|
|
;; list for "affine" use with unquote-splicing.
|
|
(-let (((forms . (&alist :with-each with-each
|
|
:with-all with-all))
|
|
(syd-parse-rest-and-keys args))
|
|
(call-cont (lambda (cont arg)
|
|
(if cont
|
|
(list (funcall cont arg))
|
|
nil)))
|
|
names)
|
|
`(progn
|
|
,@(cl-loop
|
|
for form in forms
|
|
appending (cond ((and (symbolp form) (functionp form))
|
|
(push form names)
|
|
(funcall call-cont with-each form))
|
|
((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-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)
|
|
(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))))
|
|
|
|
;; TODO: Support (syd-add-hook 'hook (defun my-hook () ...))
|
|
(defun syd-add-hook (hooks &rest functions)
|
|
(declare (indent defun))
|
|
(dolist (hook (ensure-list hooks))
|
|
(dolist (fn functions)
|
|
(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 ""))))))
|
|
|
|
(provide 'syd-prelude)
|