Welcome to the CHICKEN Scheme pasting service
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))