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))

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
What is the operator to construct pairs?
Visually impaired? Let me spell it for you (wav file) download WAV