d59c79a8d4
I'm sorry. I really wanted to improve my commit discipline. I know. I can't be fucked to comb this diff and split it into 8 properly-ordered commits, like I know I should. I'm not having a good time right now. We'll do better moving forward.
64 lines
2.7 KiB
EmacsLisp
64 lines
2.7 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))))
|
|
|
|
(cl-defun syd--lift-lambdas (forms &key with-each with-all)
|
|
;; 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)
|
|
(if cont
|
|
(lambda (name) (list (funcall with-each name)))
|
|
(lambda (_) nil))))
|
|
names)
|
|
`(progn ,@(mapconcat (lambda (form)
|
|
(cond ((and (symbolp form) (functionp form))
|
|
(push form names)
|
|
(call-cont with-each form))
|
|
((eq (car-safe form) 'defun)
|
|
(let ((name (nth 1 form)))
|
|
(push name names)
|
|
`(,form
|
|
,@(call-cont with-each))))
|
|
((eq (car-safe form) 'lambda)
|
|
(let ((name (gensym "lifted-lambda")))
|
|
(push name names)
|
|
`((defun ,name (&rest args)
|
|
(,form args))
|
|
,@(call-cont with-each))))))
|
|
(ensure-list forms))
|
|
,@(call-cont with-all names))))
|
|
|
|
;; (defun syd-hform-defun (hform)
|
|
;; "If HFORM is a defun form, return the defun's name. Otherwise, return nil"
|
|
;; (and (listp hform)
|
|
;; (<= 2 (length hform))
|
|
;; (nth 1 hform)))
|
|
|
|
(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* (function ,hook-name)))
|
|
((symbolp ,hook-or-function*)
|
|
(remove-hook ,hook-or-function* (function ,hook-name))))
|
|
,@forms)
|
|
(cond ((functionp ,hook-or-function*)
|
|
(advice-add ,hook-or-function* :before (function ,hook-name)))
|
|
((symbolp ,hook-or-function*)
|
|
(add-hook ,hook-or-function* (function ,hook-name)))))))
|
|
|
|
(provide 'syd-prelude)
|