Commit dicipline fail

users/crumb/programs/emacs/lib/syd-prelude.el

@@ -12,40 +12,70 @@
        ,todo
        (error ,todo))))
 
-(cl-defun syd--lift-lambdas (forms &key with-each with-all)
+;; 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 ((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))))
+  (-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"
-;;   (and (listp hform)
-;;        (<= 2 (length hform))
-;;        (nth 1 hform)))
+(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 _)
-  "Completely every argument, and expand to nil."
+  "Ignore each argument, and expand to nil."
   nil)
 
 (defmacro with-transient-after (hook-or-function &rest forms)
@@ -74,4 +104,30 @@ not mutated; a new plist is returned."
                          (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)