Three ways of writing callbacks in emacs pasted by megane on Fri Nov 13 18:01:18 2020
(defun mpv-insert-org-screenshot-hell (&optional pause) "Take a screenshot and insert a link and timestamp." (interactive) ;; - [[screenshot-dir/year-month/day/filename-hh:mm:ss.mmm.jpg][hh:mm:ss]] (let ((buffer (current-buffer))) (let ((k1 (lambda (&optional notpaused) (unless notpaused (message "Paused")) (let ((k2 (lambda (seek-pos) (let ((k3 (lambda (filename) (let ((path (format-time-string "~/po/Screenshots/%Y-%m/%d"))) (make-directory path t) (let ((shot-filename (format "%s/%s-%s.png" path filename (org-timer-secs-to-hms (round seek-pos))))) (message "shot-filename: %S" shot-filename) (let ((k4 (lambda (&rest _) (unless (file-exists-p shot-filename) (error "Screenshot not generated")) (with-current-buffer buffer (end-of-line) (newline) (->> (format "file:%s" shot-filename) (org-link-make-string) (insert)) (newline) (insert (format "- [%s] screenshot" (org-timer-secs-to-hms (round seek-pos)))) (newline) (org-redisplay-inline-images))))) (mpv--enqueue `("screenshot-to-file" ,(expand-file-name shot-filename) "window") k4 t))))))) (mpv--enqueue '("get_property" "filename") k3 t))))) (mpv--enqueue '("get_property" "playback-time") k2 t))))) (if pause (mpv--enqueue '("set_property" "pause" t) k1 t) (funcall k1 t))))) (defun mpv-insert-org-screenshot-->> (&optional pause) "Take a screenshot and insert a link and timestamp." (interactive) ;; - [[screenshot-dir/year-month/day/filename-hh:mm:ss.mmm.jpg][hh:mm:ss]] (let ((buffer (current-buffer)) filename shot-filename seek-pos) (->> ;; Finally, insert org link (lambda (&rest a) (if (file-exists-p shot-filename) (with-current-buffer buffer (end-of-line) (newline) (->> (format "file:%s" shot-filename) (org-link-make-string) (insert)) (newline) (insert (format "- [%s] screenshot" (org-timer-secs-to-hms (round seek-pos)))) (newline) (org-redisplay-inline-images)) (error "Screenshot not generated"))) ;; Take screenshot ((lambda (k) (lambda () ;; generate shot-filename (let ((path (format-time-string "~/po/Screenshots/%Y-%m/%d"))) (make-directory path t) (setq shot-filename (format "%s/%s-%s.png" path filename (org-timer-secs-to-hms (round seek-pos))))) (message "shot-filename: %S" shot-filename) (mpv--enqueue `("screenshot-to-file" ,(expand-file-name shot-filename) "window") k t)))) ;; Get playback-time ((lambda (k) (lambda () (mpv--enqueue '("get_property" "playback-time") (lambda (time) (setq seek-pos time) (funcall k)) t)))) ;; Get filename ((lambda (k) (lambda (&rest args) (mpv--enqueue '("get_property" "filename") (lambda (fn) (setq filename fn) (funcall k)) t)))) ;; Pause ((lambda (k) (if pause (mpv--enqueue '("set_property" "pause" t) (lambda (&rest a) (message "paused %S" a) (funcall k)) t) (funcall k))))))) (defun mpv-set-pause (pausep &optional callback) "If given, CALLBACK will be called with PAUSEP, when the operation is done." (mpv--enqueue `("set_property" "pause" ,pausep) (lambda (&rest _a) (-some-> callback (funcall pausep))) t)) (defun mpv-insert-org-screenshot (&optional pause) "Take a screenshot and insert a link and with a timestamp." (interactive "P") ;; - [[screenshot-dir/year-month/day/filename-hh:mm:ss.mmm.jpg][hh:mm:ss]] (lc buffer := (current-buffer) ;; Pause (&optional paused) :<> (if pause (mpv-set-pause t <>) (funcall <> nil)) ! (when paused (message "Paused")) ;; Get playback-time (seek-pos) :<> (mpv--enqueue '("get_property" "playback-time") <> t) ;; Get filename (filename) :<> (mpv--enqueue '("get_property" "filename") <> t) ;; Generate shot-filename path := (format-time-string "~/po/Screenshots/%Y-%m/%d") ! (make-directory path t) shot-filename := (format "%s/%s-%s.png" path filename (org-timer-secs-to-hms (round seek-pos))) ! (message "shot-filename: %S" shot-filename) ;; Take screenshot :<>! (mpv--enqueue `("screenshot-to-file" ,(expand-file-name shot-filename) "window") <> t) ! (unless (file-exists-p shot-filename) (error "Screenshot not generated")) (else ;; Finally, insert org link (with-current-buffer buffer (end-of-line) (newline) (->> (format "file:%s" shot-filename) (org-link-make-string) (insert)) (newline) (insert (format "- [%s] screenshot" (org-timer-secs-to-hms (round seek-pos)))) (newline) (org-redisplay-inline-images)))))
lc.el added by megane on Fri Nov 13 18:01:43 2020
(defmacro lc (&rest body)
"Remove indentation.
- var := exp - Bind exp to var.
- ! exp - Eval exp.
- (when p exp) - Branch when p.
- (unless p exp) - Branch when (not p).
CPS helpers:
- arg-list :<> exp - Turn rest into a lambda bound to <>. Use in exp.
- :<> exp - A shorthand for (&rest _) :<> exp."
(let* ((b body)
(fs '())
(res))
(while (not res)
(pcase b
;; var := exp
(`(,(and var (pred symbolp)) := ,exp . ,rest)
(-> (lambda (body) `(let ((,var ,exp))
,body))
(push fs))
(setq b rest))
;; lambda-list :<> exp
(`(,arglist :<> ,exp . ,rest)
(-> (lambda (body) `(let ((<> (lambda ,arglist
,body)))
,exp))
(push fs))
(setq b rest))
;; :<>! exp
(`(:<>! ,exp . ,rest)
(-> (lambda (body) `(let ((<> (lambda (&rest ,(gensym))
,body)))
,exp))
(push fs))
(setq b rest))
;; (when pred body ...)
(`((when ,p . ,then) . ,else-rest)
(-> (lambda (else) `(if ,p
(progn ,@then)
,else))
(push fs))
(setq b else-rest))
;; (unless pred body ...)
(`((unless ,p . ,then) . ,else-rest)
(-> (lambda (else) `(if (not ,p)
(progn ,@then)
,else))
(push fs))
(setq b else-rest))
;; ! exp
(`(! ,exp . ,rest)
(-> (lambda (body) `(progn ,exp ,body))
(push fs))
(setq b rest))
;; (else body ...)
(`((else . ,rest))
(setq res (-reduce-r-from #'funcall `(progn ,@rest) (reverse fs))))
('() (error "lc: Missing else"))
(f (error "lc: Unrecognized form %S" f))))
res))