Sacha Chua's Emacs configuration

(unless (assoc-default "melpa" package-archives)
  (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t))
(unless (assoc-default "nongnu" package-archives)
  (add-to-list 'package-archives '("nongnu" . "https://elpa.nongnu.org/nongnu/") t))

(add-to-list 'load-path "~/elisp")
(setq use-package-verbose t)
(setq use-package-always-ensure t)
(require 'use-package)
(use-package quelpa)
(use-package quelpa-use-package)
(quelpa-use-package-activate-advice)
(setq load-prefer-newer t)

(defun my-org-link-qr (url)
  "Display a QR code for URL in a buffer."
  (let ((buf (save-window-excursion (qrencode--encode-to-buffer (my-org-stored-link-as-url url)))))
    (if (> (frame-width) 80)
        (display-buffer-in-side-window buf '((side . right)))
      (display-buffer buf))))

(use-package qrencode
  :config
  (with-eval-after-load 'embark-org
    (define-key embark-org-link-map (kbd "q") #'my-org-link-qr)))

(defun my-embark-video ()
  "Match video."
  (let ((extensions "youtu\\.?be\\|\\(webm\\|mp4\\|flv\\)$"))
    (if-let ((link (and (derived-mode-p 'org-mode)
                        (org-element-context))))
        (when (eq (org-element-type link) 'link)
          (cond
           ((string-match extensions (org-element-property :path link))
            (cons 'video (org-element-property :path link)))))
      (when (and (derived-mode-p 'dired-mode)
                 (string-match extensions (dired-get-filename)))
        (cons 'video (dired-get-filename))))))

(with-eval-after-load 'embark
  (add-to-list 'embark-target-finders 'my-embark-video)
  (defvar-keymap my-embark-video-actions
    :doc "video"
    "d" #'my-deepgram-recognize-audio
    "$" #'my-deepgram-cost
    "m" #'mpv-play
    "c" #'my-caption-show
    "w" #'my-audio-text
    "W" #'waveform-show)
  (add-to-list 'embark-keymap-alist '(video . my-embark-video-actions)))

(defun my-embark-audio ()
  "Match audio."
  (let ((extensions "m4a\\|mp3\\|wav\\|ogg\\|opus"))
    (if-let ((link (and (derived-mode-p 'org-mode)
                        (org-element-context))))
        (when (eq (org-element-type link) 'link)
          (cond
           ((string-match extensions (org-element-property :path link))
            (cons 'audio (org-element-property :path link)))))
      (when (and (derived-mode-p 'dired-mode)
                 (string-match extensions (dired-get-filename)))
        (cons 'audio (dired-get-filename))))))

(defun my-audio-text (file &optional insert)
  "Get the text for FILE audio.
If called interactively, copy to the kill ring."
  (interactive (list (read-file-name "Audio: ")))
  (let (text)
    (cond
     ((file-exists-p (concat (file-name-sans-extension file) ".txt"))
      (with-temp-buffer
        (insert-file-contents (concat (file-name-sans-extension file) ".txt"))
        (setq text (buffer-string))))
     ;; no txt yet, is there a vtt?
     ((file-exists-p (concat (file-name-sans-extension file) ".vtt"))
      (setq text (subed-subtitle-list-text
                  (subed-parse-file (concat (file-name-sans-extension file) ".vtt")))))
     ;; no VTT, let's recognize it
     (t
      (my-deepgram-recognize-audio file)
      (when (file-exists-p (concat (file-name-sans-extension file) ".vtt"))
        (setq text (subed-subtitle-list-text
                    (subed-parse-file (concat (file-name-sans-extension file) ".vtt")))))))
    (when text
      (when (called-interactively-p 'any)
        (if insert
            (insert text "\n")
          (kill-new text)))
      text)))

(defun my-open-in-audacity (file)
  (interactive "FFile: ")
  (start-process "audacity" nil "audacity" file))

(with-eval-after-load 'embark
  (add-to-list 'embark-target-finders 'my-embark-audio)
  (defvar-keymap my-embark-audio-actions
    :doc "audio"
    "a" #'my-open-in-audacity
    "d" #'my-deepgram-recognize-audio
    "$" #'my-deepgram-cost
    "D" #'my-audio-braindump-reprocess
    "m" #'mpv-play
    "w" #'my-audio-text
    "W" #'waveform-show)
  (add-to-list 'embark-keymap-alist '(audio . my-embark-audio-actions)))

(defun my-insert-file-as-org-include (file)
  (interactive "fFile: ")
  (set-text-properties 0 (length file) nil file)
  (let ((mode (assoc-default file auto-mode-alist 'string-match)))
    (insert
     (org-link-make-string (concat "file:" file) (concat "Download " (file-name-nondirectory file))) "\n"
     "#+begin_my_details " (file-name-nondirectory file) "\n"
     (format "#+INCLUDE: %s" (prin1-to-string file))
     (if mode
         (concat " src " (replace-regexp-in-string "-mode$" "" (symbol-name mode)))
       "")
     "\n"
     "#+end_my_details\n")))

(defun my-transform-org-link-to-include ()
  (interactive)
  (let ((link (org-element-lineage (org-element-context) '(link) t))
        (mode (assoc-default (org-element-property :path link) auto-mode-alist 'string-match)))
    (when link
      (delete-region (org-element-property :begin link)
                     (org-element-property :end link))
      (my-insert-file-as-org-include (org-element-property :path link)))))


(with-eval-after-load 'embark
  (define-key embark-file-map "O" #'my-insert-file-as-org-include))

(defun my-embark-org-element ()
  "Target an Org Mode element at point."
  (save-window-excursion
    (save-excursion
      (save-restriction
        (when (derived-mode-p 'org-agenda-mode)
          (org-goto-marker-or-bmk (org-get-at-bol 'org-marker))
          (org-back-to-heading))
        (when (derived-mode-p 'org-mode)
          (let* ((context ;; Borrowed from org-open-at-point
                  ;; Only consider supported types, even if they are not the
                  ;; closest one.
                  (org-element-lineage (org-element-context)
                                       '(headline src-block link) t))
                 (type (org-element-type context))
                 (value (org-element-property :value context)))
            (cond ((eq type 'headline)
                   (cons 'org-heading (org-element-property :title context)))
                  ((eq type 'src-block)
                   (cons 'org-src-block (org-element-property :name context)))
                  ((eq type 'link)
                   (cons 'url (org-element-property :raw-link context))))))))))

(defun my-embark-org-src-block-copy-noweb-reference (element)
  (kill-new (if (org-element-property element :parameters)
                (format "<<%s(%s)>>" (org-element-property element :name)
                        (org-element-property element :parameters))
              (format "<<%s>>" (org-element-property element :parameters)))))

(defun embark-which-key-indicator ()
  "An embark indicator that displays keymaps using which-key.
The which-key help message will show the type and value of the
current target followed by an ellipsis if there are further
targets."
  (lambda (&optional keymap targets prefix)
    (if (null keymap)
        (which-key--hide-popup-ignore-command)
      (which-key--show-keymap
       (if (eq (plist-get (car targets) :type) 'embark-become)
           "Become"
         (format "Act on %s '%s'%s"
                 (plist-get (car targets) :type)
                 (embark--truncate-target (plist-get (car targets) :target))
                 (if (cdr targets) "…" "")))
       (if prefix
           (pcase (lookup-key keymap prefix 'accept-default)
             ((and (pred keymapp) km) km)
             (_ (key-binding prefix 'accept-default)))
         keymap)
       nil nil t (lambda (binding)
                   (not (string-suffix-p "-argument" (cdr binding))))))))

(setq embark-indicators
  '(embark-which-key-indicator
    embark-highlight-indicator
    embark-isearch-highlight-indicator))

(defun embark-hide-which-key-indicator (fn &rest args)
  "Hide the which-key indicator immediately when using the completing-read prompter."
  (which-key--hide-popup-ignore-command)
  (let ((embark-indicators
         (remq #'embark-which-key-indicator embark-indicators)))
      (apply fn args)))

(with-eval-after-load 'embark
  (advice-add #'embark-completing-read-prompter
              :around #'embark-hide-which-key-indicator))

(defun my-sketch-insert-file-as-link (f)
  (interactive "fSketch: ")
  (cond
   ((derived-mode-p 'org-mode)
    (insert (org-link-make-string (concat "sketch:" (file-name-nondirectory f))) "\n"))
   ((or (derived-mode-p 'html-mode) (derived-mode-p 'web-mode))
    (insert "{% sketchFull \"" (file-name-base f) "\" %}"))
   (t (insert f))))

(defun my-embark-image ()
  "Match images."
  (let ((extensions "\\(png\\|jpg\\|svg\\|gif\\)\\'"))
    (if-let ((link (and (derived-mode-p 'org-mode)
                        (org-element-context))))
        (when (eq (org-element-type link) 'link)
          (cond
           ((string= "attachment" (org-element-property :type link))
            (cons 'image (expand-file-name (org-element-property :path link)
                                           (org-attach-dir))))
           ((string-match "sketch" (org-element-property :type link))
            (cons 'image (my-get-sketch-filename (org-element-property :path link))))
           ((string-match extensions (org-element-property :path link))
            (cons 'image (org-element-property :path link)))))
      (when (and (derived-mode-p 'dired-mode)
                 (string-match extensions (dired-get-filename)))
        (cons 'image (dired-get-filename))))))
(with-eval-after-load 'embark
  (add-to-list 'embark-target-finders 'my-embark-image))

(defun my-image-open-in-annotator (file)
  (interactive "FImage: ")
  (start-process "annotator" nil "com.github.phase1geo.annotator" (expand-file-name file)))

(defun my-image-open-in-krita (file)
  (interactive "FImage: ")
  (start-process "krita" nil "krita" "--nosplash" (expand-file-name file)))

(defun my-image-open-in-inkscape (file)
  (interactive "FImage: ")
  (start-process "inkscape" nil "inkscape" (expand-file-name file)))

(defun my-image-open-in-gimp (file)
  (interactive "FImage: ")
  (start-process "gimp" nil "gimp" (expand-file-name file)))

(defun my-open-in-firefox (file)
  (interactive "FItem: ")
  (start-process "firefox" nil "firefox" (if (string-match "^http" file) file (expand-file-name file))))

(defvar my-image-autocrop-border 10)
(defun my-image-autocrop (filename &optional border)
  (interactive "FFile: ")
  (setq border (or border my-image-autocrop-border))
  (let ((args (append '("-trim")
                      (if border `("-bordercolor" "#FFFFFF" "-border" ,(number-to-string border)))
                      (list "+repage" filename))))
    (apply #'call-process "mogrify" nil nil nil args)))

(defun my-image-recognize (file)
  (interactive "FFile: ")
  (let ((data (json-parse-string
               (if (file-exists-p (concat (file-name-sans-extension file) ".json"))
                   (with-temp-buffer
                     (insert-file-contents (concat (file-name-sans-extension file) ".json"))
                     (buffer-string))
                 (with-temp-file (concat (file-name-sans-extension file) ".json")
                   (call-process "gcloud" nil t nil "ml" "vision" "detect-document" (expand-file-name file))
                   (buffer-string)))
               :object-type 'alist)))
    (if (assoc-default 'responses data)
        (assoc-default 'text (assoc-default 'fullTextAnnotation (elt (assoc-default 'responses data) 0)))
      (assoc-default 'description (elt (assoc-default 'textAnnotations data) 0)))))

(defun my-image-recognize-get-new-filename (file)
  (interactive "FFile: ")
  (if-let* ((text (my-image-recognize file))
            (id (and (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9]" text)
                     (match-string 0 text)))
            (data (and id (my-journal-get-by-zidstring id))))
      (concat id " " (plist-get data :Note) "." (file-name-extension file))))

(defun my-image-recognize-and-rename (file)
  (interactive "FFile: ")
  (let ((new-name (expand-file-name (my-image-recognize-get-new-filename file)
                                    (file-name-directory file))))
    (rename-file file new-name t)
    new-name))

(defun my-image-store (file &optional do-move)
  "Copy or move this image into public or private sketches as needed."
  (unless (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9] " (file-name-nondirectory file))
    (setq file (my-image-recognize-and-rename file)))
  (when (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9] " (file-name-nondirectory file))
    (funcall
     (if do-move
         'rename-file
       'copy-file)
     file
     (expand-file-name
      (file-name-nondirectory file)
      (if (string-match "#private" (file-name-nondirectory file))
          my-private-sketches-directory
        (car my-sketch-directories)))
     t)))

(defun my-image-copy-text (file)
  (interactive "FImage: ")
  (kill-new (my-image-recognize file)))

(defun my-image-insert-text-as-details (file)
  (interactive "FImage: ")
  (when (and (derived-mode-p 'org-mode)
             (eq (org-element-type (org-element-context)) 'link))
    (goto-char (org-element-end (org-element-context))))
  (insert "\n#+begin_my_details\n" (my-image-recognize file) "\n#+end_my_details\n"))

(with-eval-after-load 'embark
  (defvar-keymap my-embark-image-actions
    :doc "Images"
    "k" #'my-image-open-in-krita
    "a" #'my-image-open-in-annotator
    "i" #'my-image-open-in-inkscape
    "w" #'my-image-copy-text
    "c" #'my-image-autocrop
    "g" #'my-image-open-in-gimp
    "f" #'my-open-in-firefox
    "s" #'my-image-store
    "r" #'my-image-recognize-and-rename
    "C" #'my-image-recolor
    "d" #'my-image-insert-text-as-details)
  (add-to-list 'embark-keymap-alist '(image . my-embark-image-actions)))

(defun my-subed-set-timestamp-to-mpv-position (&optional rest)
  (interactive)
  (skip-chars-backward "0-9:,.")
  (when (looking-at "\\(\\([0-9]+\\):\\)?\\([0-9]+\\):\\([0-9]+\\)\\.\\([0-9]+\\)")
    (replace-match (save-match-data (subed-msecs-to-timestamp subed-mpv-playback-position)) t t)))
(defun my-embark-subed-timestamp ()
  (save-excursion
    (skip-chars-backward "0-9:,.")
    (when (looking-at "\\(\\([0-9]+\\):\\)?\\([0-9]+\\):\\([0-9]+\\)\\.\\([0-9]+\\)")
      (list 'subed-timestamp
            (propertize
             (match-string 0)
             'ms (compile-media-timestamp-to-msecs (match-string 0))
             'position (if (bolp) 'start 'stop))))))
(defun my-subed-adjust-timestamp (offset)
  (interactive (list -100))
  (save-excursion
    (skip-chars-backward "0-9:,.")
    (when (looking-at subed-vtt--regexp-timestamp)
      (let ((new-ts (+ (subed-vtt--timestamp-to-msecs (match-string 0)) offset)))
        (replace-match (save-match-data
                         (subed-vtt--msecs-to-timestamp new-ts)))
        (my-waveform-subed-show-after-time)
        new-ts))))

(defun my-subed-adjust-timestamp-up (offset)
  (interactive (list 100))
  (subed-mpv-jump (my-subed-adjust-timestamp (- offset))))

(defun my-subed-adjust-timestamp-down (offset)
  (interactive (list -100))
  (subed-mpv-jump (my-subed-adjust-timestamp (- offset))))

(defhydra my-subed-adjust-timestamp ()
  ("<up>" my-subed-adjust-timestamp-up "Up" :exit nil)
  ("<down>" my-subed-adjust-timestamp-down "Down" :exit nil))

(defun my-subed-copy-timestamp-from-previous ()
  (interactive)
  (let ((ms (save-excursion (subed-backward-subtitle-time-stop) (subed-subtitle-msecs-stop))))
    (subed-set-subtitle-time-start ms)))
(defun my-subed-copy-timestamp-to-next ()
  (interactive)
  (let ((ms (subed-subtitle-msecs-stop)))
    (save-excursion
      (subed-forward-subtitle-time-stop) (subed-set-subtitle-time-start ms))))
(defun my-subed-copy-timestamp-dwim ()
  (interactive)
  (save-excursion
    (skip-chars-backward "0-9:,.")
    (if (bolp)
        (my-subed-copy-timestamp-from-previous)
      (my-subed-copy-timestamp-to-next))))

(use-package casual-symbol-overlay
  :if my-laptop-p
  :after embark
  :init
  (with-eval-after-load 'embark
    (keymap-set embark-symbol-map "z" #'casual-symbol-overlay-tmenu)))

(defun my-hydra-format-head (h)
  (let ((key-binding (elt h 0))
        (hint (elt h 2))
        (cmd (and (elt h 1) (prin1-to-string (elt h 1)))))
    (if cmd
        (format "%s (%s) - %s" hint key-binding cmd)
      (format "%s (%s)" hint key-binding))))

(defun my-hydra-heads-to-candidates (base)
  (mapcar (lambda (h)
            (cons (my-hydra-format-head h) (hydra--head-name h base)))
          (symbol-value (intern (concat (symbol-name base) "/heads")))))

(defun my-hydra-execute-extended (&optional _ hydra-base)
  (interactive (list current-prefix-arg nil))
  (hydra-keyboard-quit)
  (let* ((candidates (my-hydra-heads-to-candidates
                      (or hydra-base
                          (intern
                           (replace-regexp-in-string "/body$" ""
                                                     (symbol-name hydra-curr-body-fn))))))
         (command-name (completing-read "Cmd: " candidates))
         (bind (assoc-default command-name candidates 'string=)))
    (cond
     ((null bind) nil)
     ((hydra--callablep bind) (call-interactively bind)))))

(with-eval-after-load 'hydra
  (define-key hydra-base-map (kbd "<tab>") #'my-hydra-execute-extended))

(defalias 'my-complete-blog-post-url #'my-org-blog-complete)

(defun my-blog-posts ()
  (let ((json-object-type 'alist))
    (json-read-file "~/proj/static-blog/_site/blog/all/index.json")))

(defun my-blog-edit-html (url)
  (interactive (list (my-org-blog-complete)))
  (let ((base (replace-regexp-in-string
               (concat "^" (regexp-quote my-blog-base-url))
               ""
               url)))
    (catch 'found
      (dolist (f (list (expand-file-name "index.html" (expand-file-name base my-11ty-base-dir))
                       (expand-file-name (replace-regexp-in-string "/?$" ".html" base) my-11ty-base-dir)))
        (when (file-exists-p f)
          (find-file f)
          (throw 'found f))))))

(defun my-view-blog-post-locally (url)
  (interactive (list (my-org-blog-complete)))
  (browse-url
   (replace-regexp-in-string
    (concat "^" (regexp-quote my-blog-base-url))
    "https://localhost:8080/"
    url)))

(defun my-insert-blog-post-url (url)
  (interactive (list (my-complete-blog-post-url)))
  (insert url))

(defun my-blog-title (url)
  (let ((base (replace-regexp-in-string
               (concat "^" (regexp-quote my-blog-base-url))
               "/"
               url)))
    (alist-get 'title
               (seq-find (lambda (o)
                           (string= (alist-get 'permalink o) base))
                         (my-blog-posts)))))

(defun my-insert-blog-post-link (url)
  (interactive (list (my-complete-blog-post-url)))
  (if (derived-mode-p 'org-mode)
      (insert (org-link-make-string
               url
               (my-blog-title url)))
    (insert url)))

(declare-function 'my-geeqie-view "Sacha.el")
(defun my-preview-image (candidate state)
  (when (and my-sketch-preview candidate) (my-geeqie-view (list candidate)))
  nil)

(defun my-complete-sketch-filename ()
  (interactive)
  (consult--read (my-sketches)
       :sort nil
       :state 'my-preview-image
       :prompt "Sketch: "
       :category 'sketch))

(defun my-date-from-filename (filename)
  (let ((f (file-name-nondirectory filename)))
    (if (string-match "^[-0-9]+" f)
        (replace-regexp-in-string "[^0-9]" "" (match-string 0 f))
      nil)))

(defvar my-sketches nil "Cache for sketch filenames.")
(defun my-sketches ()
  (interactive)
  (sort
   (apply 'append (mapcar (lambda (dir)
                            (directory-files dir t "\\.\\(jpe?g\\|png\\|svg\\)$"))
                          my-sketch-directories))
   (lambda (a b)
     (string< (concat (or (my-date-from-filename b) "0") (file-name-nondirectory b))
              (concat (or (my-date-from-filename a) "0") (file-name-nondirectory a))))))

(defvar my-sketch-preview nil "Non-nil means preview images.")
(defun my-find-sketch (file)
  (interactive (list (my-complete-sketch-filename)))
  (find-file file))

(defun my-sketch-prepare-post (file)
  (interactive (list (my-complete-sketch-filename)))
  (insert (org-link-make-string (concat "sketchFull:" (file-name-base file))))
  (let ((text (my-sketch-text file)))
    (when text
      (insert (format "\n\n#+begin_my_src \"Text from %s\"\n%s\n#")))))

(defun my-sketch-text (file)
  (setq file
        (if (string-match ".json" file) file
          (concat (file-name-sans-extension file) ".json")))
  (when (file-exists-p file)
    (with-temp-buffer
      (insert-file-contents file)
      (goto-char (point-min))
      (let ((json-object-type 'alist))
        (assoc-default 'description (elt (assoc-default 'textAnnotations (json-read)) 0))))))

(defun my-sketch-insert-text-from-json (file)
  (interactive "FJSON: ")
  (let ((text (my-sketch-text file)))
    (insert (or text ""))))

(use-package consult-dir
       :ensure t
       :bind (("C-x C-d" . consult-dir)
              :map minibuffer-local-completion-map
              ("C-x C-d" . consult-dir)
              ("C-x C-j" . consult-dir-jump-file)))

;; https://karthinks.com/software/jumping-directories-in-eshell/
(defun eshell/z (&optional regexp)
  "Navigate to a previously visited directory in eshell, or to
any directory proferred by `consult-dir'."
  (let ((eshell-dirs (delete-dups
                      (mapcar 'abbreviate-file-name
                              (ring-elements eshell-last-dir-ring)))))
    (cond
     ((and (not regexp) (featurep 'consult-dir))
      (let* ((consult-dir--source-eshell `(:name "Eshell"
                                                 :narrow ?e
                                                 :category file
                                                 :face consult-file
                                                 :items ,eshell-dirs))
             (consult-dir-sources (cons consult-dir--source-eshell
                                        consult-dir-sources)))
        (eshell/cd (substring-no-properties
                    (consult-dir--pick "Switch directory: ")))))
     (t (eshell/cd (if regexp (eshell-find-previous-directory regexp)
                     (completing-read "cd: " eshell-dirs)))))))

(use-package consult
  :after projectile
  :defines consult-buffer-sources
  :config
  (projectile-load-known-projects)
  (setq my-consult-source-projectile-projects
        `(:name "Projectile projects"
                :narrow   ?P
                :category project
                :action   ,#'projectile-switch-project-by-name
                :items    ,projectile-known-projects))
  (add-to-list 'consult-buffer-sources my-consult-source-projectile-projects 'append))

(defun my-insert-or-replace-link (url &optional title)
  "Insert a link, wrap the current region in a link, or replace the current link."
  (cond
   ((derived-mode-p 'org-mode)
    (cond
     ((org-in-regexp org-link-bracket-re 1)
      (when (match-end 2) (setq title (match-string-no-properties 2)))
      (delete-region (match-beginning 0) (match-end 0)))
     ((org-in-regexp org-link-any-re 1)
      (delete-region (match-beginning 0) (match-end 0)))
     ((region-active-p)
      (setq title (buffer-substring-no-properties (region-beginning) (region-end)))
      (delete-region (region-beginning) (region-end))))
    ;; update link
    (insert (org-link-make-string url title)))
   ((derived-mode-p 'org-mode)     ; not in a link
    (insert (org-link-make-string url title)))
   ((and (region-active-p) (derived-mode-p 'markdown-mode))
    (setq title (buffer-substring-no-properties (region-beginning) (region-end)))
    (delete-region (region-beginning) (region-end))
    (insert (format "[%s](%s)" title url)))
   ((derived-mode-p 'markdown-mode)
    (insert (format "[%s](%s)" title url)))
   (t
    (insert (format "%s (%s)" title url)))))

;; override the embark actions
(defun my-consult-omni-embark-copy-url-as-kill (cand)
  "Don't add spaces."
  (when-let ((s (and (stringp cand) (get-text-property 0 :url cand))))
    (kill-new (string-trim s))))

(defun my-consult-omni-embark-insert-url (cand)
  "Don't add spaces."
  (when-let ((s (and (stringp cand) (get-text-property 0 :url cand))))
    (insert (string-trim s))))

(defun my-consult-omni-embark-copy-title-as-kill (cand)
  "Don't add spaces."
  (when-let ((s (and (stringp cand) (get-text-property 0 :title cand))))
    (kill-new (string-trim s))))

(defun my-consult-omni-embark-insert-title (cand)
  "Don't add spaces."
  (when-let ((s (and (stringp cand) (get-text-property 0 :title cand))))
    (insert (string-trim s))))

(defun my-consult-omni-embark-insert-link (cand)
  "Don't add spaces."
  (let ((url (and (stringp cand) (get-text-property 0 :url cand )))
        (title (and (stringp cand) (get-text-property 0 :title cand))))
    (my-insert-or-replace-link url title)))

(use-package consult-omni
  :load-path "~/vendor/consult-omni"
  :after (consult embark)
  :custom
  (consult-omni-show-preview t) ;;; show previews
  (consult-omni-preview-key "C-o") ;;; set the preview key to C-o
  :config
  (add-to-list 'load-path "~/vendor/consult-omni/sources")
  (require 'consult-omni-sources)
  (require 'consult-omni-embark)
  (setq consult-omni-sources-modules-to-load (list 'consult-omni-wikipedia 'consult-omni-google))
  (consult-omni-sources-load-modules)
  (setq consult-omni-default-interactive-command #'consult-omni-google)
  :bind
  (("M-g w" . consult-omni)
   :map consult-omni-embark-general-actions-map
   ("i l" .  #'my-consult-omni-embark-insert-link)
   ("i u" .  #'my-consult-omni-embark-insert-url)
   ("i t" .  #'my-consult-omni-embark-insert-title)
   ("w u" . #'my-consult-omni-embark-copy-url-as-kill)
   ("w t" . #'my-consult-omni-embark-copy-title-as-kill)))

  (defun my-marginalia-annotate-journal (cand)
    (when-let ((o (cdr (assoc cand my-journal-search-cache))))
      (marginalia--fields
       ((plist-get o :Category)
  :face 'marginalia-documentation
  :truncate 13))))

  (use-package marginalia
    :config
    (add-to-list 'marginalia-annotator-registry '(journal my-marginalia-annotate-journal builtin none)))

(defun my-setup-color-theme ()
  (interactive)
  (when (display-graphic-p)
    (load-theme (car modus-themes-to-toggle))))
(use-package modus-themes
  :quelpa (modus-themes :fetcher github :repo "protesilaos/modus-themes")
  :init (setq modus-themes-to-toggle '(modus-vivendi-tinted modus-operandi-tinted))
  :config (my-setup-color-theme))

(use-package highlight-sexp
  :quelpa
  (highlight-sexp :repo "daimrod/highlight-sexp" :fetcher github :version original)
  :after modus-themes
  :hook
  ((emacs-lisp-mode . highlight-sexp-mode)
   (modus-themes-after-load-theme . my-hl-sexp-update-all-overlays))
  :config
  (defun my-hl-sexp-update-overlay ()
    (when (overlayp hl-sexp-overlay)
      (overlay-put
       hl-sexp-overlay
       'face
       `(:background
         ,(modus-themes-get-color-value 'bg-inactive)))))
  (defun my-hl-sexp-update-all-overlays (&rest args)
    (dolist (buf (buffer-list))
      (with-current-buffer buf
        (when highlight-sexp-mode
          (my-hl-sexp-update-overlay)))))
  (advice-add 'hl-sexp-create-overlay :after 'my-hl-sexp-update-overlay))

(display-time-mode 1)

(use-package diminish :ensure t)

(defun my-update-active-mode-line-colors ()
  (set-face-attribute
   'mode-line nil
   :foreground (modus-themes-get-color-value 'fg-mode-line-active)
   :background (modus-themes-get-color-value 'bg-blue-subtle)))
(use-package modus-themes
  :hook
  (modus-themes-after-load-theme . my-update-active-mode-line-colors))

(defun my-pdf-view-insert-current-page-text ()
  (interactive)
  (let (text)
    (catch 'found
      (walk-window-tree
       (lambda (win)
         (with-selected-window win
           (when (derived-mode-p 'pdf-view-mode)
             (setq text
                   (pdf-info-gettext (pdf-view-current-page)
                                     (list 0 0 1 1)))
             (throw 'found text))))))
    (when text (save-excursion (insert text)))))

(defun zap-to-isearch (rbeg rend)
  "Kill the region between the mark and the closest portion of
      the isearch match string. The behaviour is meant to be analogous
      to zap-to-char; let's call it zap-to-isearch. The deleted region
      does not include the isearch word. This is meant to be bound only
      in isearch mode.  The point of this function is that oftentimes
      you want to delete some portion of text, one end of which happens
      to be an active isearch word. The observation to make is that if
      you use isearch a lot to move the cursor around (as you should,
      it is much more efficient than using the arrows), it happens a
      lot that you could just delete the active region between the mark
      and the point, not include the isearch word."
  (interactive "r")
  (when (not mark-active)
    (error "Mark is not active"))
  (let* ((isearch-bounds (list isearch-other-end (point)))
         (ismin (apply 'min isearch-bounds))
         (ismax (apply 'max isearch-bounds))
         )
    (if (< (mark) ismin)
        (kill-region (mark) ismin)
      (if (> (mark) ismax)
          (kill-region ismax (mark))
        (error "Internal error in isearch kill function.")))
    (isearch-exit)
    ))

(define-key isearch-mode-map [(meta z)] 'zap-to-isearch)

(require 'transient)
(transient-define-prefix cc/isearch-menu ()
  "isearch Menu"
  [["Edit Search String"
    ("e"
     "Edit the search string (recursive)"
     isearch-edit-string
     :transient nil)
    ("w"
     "Pull next word or character word from buffer"
     isearch-yank-word-or-char
     :transient nil)
    ("s"
     "Pull next symbol or character from buffer"
     isearch-yank-symbol-or-char
     :transient nil)
    ("l"
     "Pull rest of line from buffer"
     isearch-yank-line
     :transient nil)
    ("y"
     "Pull string from kill ring"
     isearch-yank-kill
     :transient nil)
    ("t"
     "Pull thing from buffer"
     isearch-forward-thing-at-point
     :transient nil)]

   ["Replace"
    ("q"
     "Start ‘query-replace’"
     isearch-query-replace
     :if-nil buffer-read-only
     :transient nil)
    ("x"
     "Start ‘query-replace-regexp’"
     isearch-query-replace-regexp
     :if-nil buffer-read-only
     :transient nil)]]

  [["Toggle"
    ("X"
     "Regexp searching"
     isearch-toggle-regexp
     :transient nil)
    ("S"
     "Symbol searching"
     isearch-toggle-symbol
     :transient nil)
    ("W"
     "Word searching"
     isearch-toggle-word
     :transient nil)
    ("F"
     "Case fold"
     isearch-toggle-case-fold
     :transient nil)
    ("L"
     "Lax whitespace"
     isearch-toggle-lax-whitespace
     :transient nil)]

   ["Misc"
    ("o"
     "occur"
     isearch-occur
     :transient nil)
    ("h"
     "highlight"
     isearch-highlight-regexp
     :transient nil)
    ("H"
     "highlight lines"
     isearch-highlight-lines-matching-regexp
     :transient nil)]])

(define-key isearch-mode-map (kbd "M-S") 'cc/isearch-menu)

(setq isearch-invisible t
      search-invisible t)

(with-eval-after-load 'occur
  (keymap-set occur-mode-map "C-x C-q" #'occur-edit-mode))

(use-package peep-dired
  :if my-laptop-p
  :bind (:map peep-dired-mode-map
              ("SPC" . nil)
              ("<backspace>" . nil)))

(defun my-save-photo (name)
  (interactive "MName: ")
  (let* ((file (dired-get-filename))
         new-name)
    (cond
     ((string-match "CameraZOOM-\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9][0-9]\\)" file)
      (setq new-name
            (format "%s-%s-%s %s.%s.%s.%s %s.jpg"
                    (match-string 1 file)
                    (match-string 2 file)
                    (match-string 3 file)
                    (match-string 4 file)
                    (match-string 5 file)
                    (match-string 6 file)
                    (match-string 7 file)
                    name)))
     ((string-match "\\([0-9][0-9][0-9][0-9]\\)[\\.-]\\([0-9][0-9]\\)[\\.-]\\([0-9][0-9]\\)[\\.- ]\\([0-9][0-9]\\)\\.\\([0-9][0-9]\\)\\.\\([0-9][0-9]\\)" file)
      (setq new-name
            (format "%s-%s-%s %s.%s.%s %s.jpg"
                    (match-string 1 file)
                    (match-string 2 file)
                    (match-string 3 file)
                    (match-string 4 file)
                    (match-string 5 file)
                    (match-string 6 file)
                    name)))
     (t (setq new-name (concat (file-name-sans-extension (file-name-nondirectory file)) " " name ".jpg"))))
    (when (string-match "A-" name)
      (copy-file file (expand-file-name new-name my-kid-photo-directory)))
    (rename-file file (expand-file-name new-name "~/archives/2016/photos/selected/"))))
(defun my-backup-media ()
  (interactive)
  (mapcar (lambda (file)
            (rename-file
             file
             (expand-file-name
              (file-name-nondirectory file)
              (cond
               ((string-match "mp4" file) "~/archives/2016/videos/")
               ((string-match "mp3\\|wav" file) "~/archives/2016/audio/")
               (t "~/archives/2016/photos/backup/")))))
          (dired-get-marked-files)))
(bind-key "b" 'my-save-photo dired-mode-map)
(bind-key "r" 'my-backup-media dired-mode-map)

(defun my-describe-random-interactive-function ()
  (interactive)
  "Show the documentation for a random interactive function.
     Consider only documented, non-obsolete functions."
  (let (result)
    (mapatoms
     (lambda (s)
       (when (and (commandp s)
                  (documentation s t)
                  (null (get s 'byte-obsolete-info)))
         (setq result (cons s result)))))
    (describe-function (elt result (random (length result))))))

(defun my-shuffle-lines-in-region (beg end)
  (interactive "r")
  (let ((list (split-string (buffer-substring beg end) "[\r\n]+")))
    (delete-region beg end)
    (insert (string-join (seq-sort-by (lambda (_) (random)) #'<= list) "\n"))))

(defun my-audio-braindump-process (files &optional force)
  (interactive (list (cond
                      ((and (derived-mode-p 'dired-mode)
                            (dired-get-marked-files))
                       (dired-get-marked-files))
                      ((derived-mode-p 'dired-mode)
                       (list (dired-get-filename)))
                      ((string-match "\\.txt$" (buffer-file-name))
                       (list (buffer-file-name)))
                      (t (read-file-name "Transcript: ")))
                     current-prefix-arg))
  (mapc (lambda (f)
          (when (string-match "txt" f)
            (my-audio-braindump-make-todo f force))) files))

(defvar my-deepgram-length-threshold 45 "Number of characters.")
(defvar my-deepgram-time-threshold 10 "Number of seconds since the first word.")

(defun my-deepgram-recognize-audio (audio-file &optional diarize)
  "Send AUDIO-FILE to Deepgram, save the JSON, and create a VTT.
If DIARIZE is non-nil, identify speakers."
  (require 'subed)
  (interactive (list (if (auth-info-password (car (auth-source-search :host "https://api.deepgram.com")))
                         (read-file-name "Audio file: ")
                       (error "Please put deepgram API key in auth sources."))))
  (with-current-buffer (get-buffer-create "*Deepgram*")
    (erase-buffer)
    (unless (string-match "\\(opus\\|wav\\|mp3\\)$" audio-file)
      (if (file-exists-p (concat (file-name-sans-extension audio-file) ".opus"))
          (setq audio-file (concat (file-name-sans-extension audio-file) ".opus"))
        (call-process "ffmpeg" nil t t "-i" (expand-file-name audio-file)
                      "-ac" "1" "-y"
                      (expand-file-name (concat (file-name-sans-extension audio-file) ".opus")))
        (setq audio-file (concat (file-name-sans-extension audio-file) ".opus"))))
    (unless (file-exists-p (expand-file-name (concat (file-name-sans-extension audio-file) ".json")))
      (call-process
       "curl" nil t t "--request" "POST" "--header"
       (concat "Authorization: Token " (auth-info-password (car (auth-source-search :host "https://api.deepgram.com"))))
       "--header" (concat "Content-Type: " (mailcap-file-name-to-mime-type audio-file))
       "--data-binary" (concat "@" (expand-file-name audio-file))
       "--url"
       (concat
        "https://api.deepgram.com/v1/listen?punctuate=true&model=whisper-large&smart_format=true&utterances=true"
        (if diarize
            "&diarize=true"
          ""))
       "-o"
       (expand-file-name (concat (file-name-sans-extension audio-file) ".json"))))
    (my-deepgram-convert-json-to-vtt (concat (file-name-sans-extension audio-file) ".json")))
  (find-file (concat (file-name-sans-extension audio-file) ".vtt")))

(defun my-emacsconf-extract-deepgram-recognize-qa-for-talk (talk)
  "Send the QA (or main) Opus file for TALK to Deepgram.
Save the results as JSON and VTT."
  (interactive (list (emacsconf-complete-talk-info)))
  (setq talk (emacsconf-resolve-talk talk))
  (if (or (emacsconf-talk-file talk "--answers--original.json")
          (emacsconf-talk-file talk "--original.json"))
      (message "Files already exist for %s" (plist-get talk :slug))
      (if-let ((file
                (or (emacsconf-talk-file talk "--answers--original.opus")
                    (emacsconf-talk-file talk "--original.opus"))))
          (my-deepgram-recognize-audio file)
        (error "No file to recognize for %s" (plist-get talk :slug)))))

(defun my-deepgram-parse (json-file)
  "Convert JSON-FILE into a list of subtitles."
  (let* ((json-object-type 'alist)
         (json (json-read-file json-file))
         (words
          (assoc-default
           'words
           (aref (assoc-default 'alternatives (aref (let-alist json .results.channels) 0)) 0)))
         (halfway-length (/ my-deepgram-length-threshold 2))
         subtitles
         current
         current-length
         last-speaker
         last-text
         current-text)
    (dolist (speaker (seq-group-by (lambda (o) (assoc-default 'speaker o)) words))
      (setq current-length 0 current nil)
      (dolist (word (cdr speaker))
        (let-alist word
          ;; determine whether we are adding to the existing one.
          ;; start a new one if length > length-threshold
          ;; or time > time-threshold
          (when (or (> (+ (length .punctuated_word)
                          current-length)
                       my-deepgram-length-threshold)
                    (and (car current)
                         (> .start (+ (assoc-default 'start (car current))
                                      my-deepgram-time-threshold))))
            ;; copy the previous subtitle
            (push current subtitles)
            (setq current nil current-length 0))
          (push word current)
          (setq current-length (+ (length .punctuated_word) current-length 1))
          (when (and (string-match "[,\\.?]" .punctuated_word)
                     (> current-length halfway-length))
            (push current subtitles)
            (setq current nil current-length 0))))
      (when current (push current subtitles)))
    (seq-keep
     (lambda (entry)
       (setq current-text
             (mapconcat (lambda (w) (assoc-default 'punctuated_word w))
                        (reverse entry) " "))
       (when (not (string= (downcase current-text) (or last-text "")))
         (setq last-text (downcase current-text))
         (list nil
               (* (assoc-default 'start (car (last entry)) nil 0) 1000)
               (* (assoc-default 'end (car entry) nil 0) 1000)
               ;; add speaker tag?
               (concat
                (if (and (assoc-default 'speaker (car entry))
                         (or (null last-speaker)
                             (not (eq last-speaker (assoc-default 'speaker (car entry))))))
                    (progn
                      (setq last-speaker (assoc-default 'speaker (car entry)))
                      (format "[Speaker %d]: " (assoc-default 'speaker (car entry))))
                  "")
                current-text
                ))))
     (sort subtitles
           (lambda (a b)
             ;; sort by time
             (< (assoc-default 'start (car a) nil 0)
                (assoc-default 'start (car b) nil 0)))))))

(defun my-deepgram-convert-json-to-vtt (json-file &optional force)
  (interactive (list (read-file-name "JSON: ") current-prefix-arg))
  "Convert JSON-FILE into a VTT."
  (subed-create-file
   (concat (file-name-sans-extension json-file) ".vtt")
   (my-deepgram-parse json-file)
   force))

(defconst deepgram-whisper-large-per-min 0.0048)
(defun my-deepgram-cost (file)
  (interactive "FFile: ")
  (let* ((whisper-large-per-min deepgram-whisper-large-per-min)
         (nova2-streaming-per-min 0.0059)
         (duration (/ (ceiling (/ (compile-media-get-file-duration-ms file) 1000.0)) 60))
         (msg (format "%.1f minutes: USD %.2f batch, USD %.2f streaming"
                      duration
                      (* duration whisper-large-per-min)
                      (* duration nova2-streaming-per-min))))
    (when (called-interactively-p 'any)
      (message "%s" msg)
      (kill-new msg))
    (list
     duration
     (* duration whisper-large-per-min)
     (* duration nova2-streaming-per-min))))

(defun my-audio-braindump-reprocess (audio-file)
  (interactive
   (list
    (let ((default (cond
                    ((derived-mode-p 'org-mode)
                     (save-excursion
                       (org-back-to-heading)
                       (when (re-search-forward "\\[Audio\\]" nil (save-excursion (org-end-of-subtree)))
                         (org-element-property :path (org-element-context)))))
                    ((file-exists-p (concat (file-name-sans-extension (buffer-file-name)) ".m4a"))
                     (concat (file-name-sans-extension (buffer-file-name)) ".m4a")))))
      (read-file-name (if default (format "Audio (%s): " default)
                        "Audio: ")
                      nil default))))
  (save-window-excursion
    (unless (file-exists-p (concat (file-name-sans-extension audio-file) ".json"))
      (my-deepgram-recognize-audio audio-file))
    (with-temp-file (concat (file-name-sans-extension audio-file) ".txt")
      (insert
       (subed-subtitle-list-text
        (my-deepgram-parse (concat (file-name-sans-extension audio-file) ".json"))))
      (goto-char (point-min))
      (my-audio-braindump-prepare-alignment-breaks))
    (with-current-buffer (find-file-noselect (concat (file-name-sans-extension audio-file) ".txt"))
      (subed-align audio-file (concat (file-name-sans-extension audio-file) ".txt") "VTT")))
  (find-file my-audio-braindump-braindump-file)
  (goto-char (point-min))
  (my-audio-braindump-insert-subtitles-as-org-tree (concat (file-name-sans-extension audio-file) ".vtt")))

(defun my-gladia-parse (json-file)
  "Convert JSON-FILE into a list of subtitles."
  (let* ((json-object-type 'alist)
         (json (json-read-file json-file))
         (words
          (seq-mapcat (lambda (pred) (seq-map (lambda (w)
                                                (append
                                                 (list
                                                  (cons 'speaker (when (not (string= "speaker_not_activated" (assoc-default 'speaker pred)))
                                                                   (assoc-default 'speaker pred)))
                                                  (cons 'start (assoc-default 'time_begin pred))
                                                  (cons 'end (assoc-default 'time_end pred))
                                                  (cons 'punctuated_word (string-trim (assoc-default 'word w))))
                                                 w))
                                              (assoc-default 'words pred)))
                      (assoc-default 'prediction json)))
         (halfway-length (/ my-deepgram-length-threshold 2))
         subtitles
         current
         current-length
         last-speaker
         last-text
         current-text)
    (dolist (speaker (seq-group-by (lambda (o) (assoc-default 'speaker o)) words))
      (setq current-length 0 current nil)
      (dolist (word (cdr speaker))
        (let-alist word
          ;; determine whether we are adding to the existing one.
          ;; start a new one if length > length-threshold
          ;; or time > time-threshold
          (when (or (> (+ (length .punctuated_word)
                          current-length)
                       my-deepgram-length-threshold)
                    (and (car current)
                         (> .start (+ (assoc-default 'start (car current))
                                      my-deepgram-time-threshold))))
            ;; copy the previous subtitle
            (push current subtitles)
            (setq current nil current-length 0))
          (push word current)
          (setq current-length (+ (length .punctuated_word) current-length 1))
          (when (and (string-match "[,\\.?]" .punctuated_word)
                     (> current-length halfway-length))
            (push current subtitles)
            (setq current nil current-length 0))))
      (when current (push current subtitles)))
    (seq-keep
     (lambda (entry)
       (setq current-text
             (mapconcat (lambda (w) (assoc-default 'punctuated_word w))
                        (nreverse entry) " "))
       (when (not (string= (downcase current-text) (or last-text "")))
         (setq last-text (downcase current-text))
         (list nil
               (* (assoc-default 'start (car entry) nil 0) 1000)
               (* (assoc-default 'end (car (last entry)) nil 0) 1000)
               ;; add speaker tag?
               (concat
                (if (and (assoc-default 'speaker (car entry))
                         (or (null last-speaker)
                             (not (eq last-speaker (assoc-default 'speaker (car entry))))))
                    (progn
                      (setq last-speaker (assoc-default 'speaker (car entry)))
                      (format "[Speaker %s]: " (assoc-default 'speaker (car entry))))
                  "")
                current-text
                ))))
     (sort subtitles
           (lambda (a b)
             ;; sort by time
             (< (assoc-default 'start (car a) nil 0)
                (assoc-default 'start (car b) nil 0)))))))

(defun my-gladia-recognize-audio (audio-file &optional diarize other-options)
  "Send AUDIO-FILE to Gladia, save the JSON, and create a VTT.
If DIARIZE is non-nil, identify speakers."
  (interactive (list (if (getenv "GLADIA_API_KEY")
                         (read-file-name "Audio file: ")
                       (error "Please specify GLADIA_API_KEY."))))
  (with-current-buffer (get-buffer-create "*recognition*")
    (erase-buffer)
    (call-process
     "curl" nil t t "--request" "POST" "--header"
     (concat "x-gladia-key: " (getenv "GLADIA_API_KEY"))
     "--header" (concat "Content-Type: multipart/form-data" )
     "--header" (concat "Accept: application/json")
     "-F" (concat "audio=@" (expand-file-name audio-file) ";type=" (mailcap-file-name-to-mime-type audio-file))
     "-F" (concat "toggle_noise_reduction=true&output_format=json" (or other-options "") (if diarize "&toggle_diarization=true" ""))
     "--url" "https://api.gladia.io/audio/text/audio-transcription?toggle_noise_reduction=true&output_format=json"
     "-o"
     (expand-file-name (concat (file-name-sans-extension audio-file) ".json")))
    (subed-create-file
     (concat (file-name-sans-extension audio-file) ".vtt")
     (my-gladia-parse (concat (file-name-sans-extension audio-file) ".json"))))
  (find-file (concat (file-name-sans-extension audio-file) ".vtt")))

(setq org-use-effective-time t)

(defun my-org-use-speed-commands-for-headings-and-lists ()
  "Activate speed commands on list items too."
  (or (and (looking-at org-outline-regexp) (looking-back "^\**" nil))
      (save-excursion (and (looking-at (org-item-re)) (looking-back "^[ \t]*" nil)))))
(setq org-use-speed-commands 'my-org-use-speed-commands-for-headings-and-lists)

(defun my-org-subtree-text ()
  (save-excursion
    (buffer-substring (save-excursion (org-end-of-meta-data t) (point)) (org-end-of-subtree))))

(defun my-org-mark-done ()
  (interactive)
  (my-org-with-current-task (org-todo "DONE")))
(defun my-org-mark-done-and-add-to-journal (&optional note category)
  (interactive (list (if current-prefix-arg
                         (read-string (format "Note (%s): " (org-get-heading t t t t)))
                       (org-get-heading t t t t))
                     (or (org-entry-get (point) "JOURNAL_CAT") (my-journal-read-category (my-journal-guess-category)))))
  (my-org-with-current-task
   (org-todo "DONE")
   (org-entry-put (point) "JOURNAL_CAT" category)
   (let* ((title (or note (org-get-heading t t t t)))
          (zid (org-entry-get (point) "ZIDSTRING"))
          (other (if current-prefix-arg (substring-no-properties (my-org-subtree-text))))
          (date (unless zid
                         (format-time-string "%Y-%m-%d %H:%M"
                                             (let ((base-date (org-read-date nil t (org-entry-get (point) "CREATED"))))
                                               (if (string-match "Yesterday " title)
                                                   (progn
                                                     (setq title (replace-match "" nil nil title))
                                                     (org-read-date nil t "--1" nil (org-time-string-to-time (org-entry-get (point) "CREATED"))))
                                                 base-date))))))
     (if zid
         (my-journal-update (list :ZIDString zid :Note title :Category category :Other other))
       (org-entry-put (point) "ZIDSTRING"
                      (plist-get
                       (my-journal-post title
                                        :Category category
                                        :Other other
                                        :Date date)
                       :ZIDString)))
     (org-back-to-heading)
     (my-copy-observation))))

(with-eval-after-load 'org
  (let ((listvar (if (boundp 'org-speed-commands) 'org-speed-commands
                   'org-speed-commands-user)))
    (add-to-list listvar '("A" org-archive-subtree-default))
    (add-to-list listvar '("x" org-todo "DONE"))
    (add-to-list listvar '("X" call-interactively 'my-org-mark-done-and-add-to-journal))
    (add-to-list listvar '("y" org-todo-yesterday "DONE"))
    (add-to-list listvar '("!" my-org-clock-in-and-track))
    (add-to-list listvar '("s" call-interactively 'org-schedule))
    (add-to-list listvar '("d" my-org-move-line-to-destination))
    (add-to-list listvar '("i" call-interactively 'org-clock-in))
    (add-to-list listvar '("o" call-interactively 'org-clock-out))
    (add-to-list listvar '("$" call-interactively 'org-archive-subtree)))
  (bind-key "!" 'my-org-clock-in-and-track org-agenda-mode-map))

(defun my-org-follow-entry-link ()
  "Follow the defined link for this entry."
  (interactive)
  (if (org-entry-get (point) "LINK")
      (org-open-link-from-string (org-entry-get (point) "LINK"))
    (org-open-at-point)))

(defun my-org-link-projects (location)
  "Add link properties between the current subtree and the one specified by LOCATION."
  (interactive
   (list (let ((org-refile-use-cache nil))
           (org-refile-get-location "Location"))))
  (let ((link1 (org-store-link nil)) link2)
    (save-window-excursion
      (org-refile 4 nil location)
      (setq link2 (org-store-link nil))
      (org-set-property "LINK" link1))
    (org-set-property "LINK" link2)))

(with-eval-after-load 'org
  (bind-key "C-c k" 'org-cut-subtree org-mode-map)
  (setq org-yank-adjusted-subtrees t))

(defun my-org-back-to-heading ()
  (interactive)
  (org-back-to-heading))

(use-package org
  :bind (:map org-mode-map
              ("C-c b" . my-org-back-to-heading)
              ("C-c p" . org-display-outline-path)))

(defun my-org-show-row-and-column (point)
  (interactive "d")
  (save-excursion
    (goto-char point)
    (let ((row (s-trim (org-table-get nil 1)))
          (col (s-trim (org-table-get 1 nil)))
          (message-log-max nil))
      (message "%s - %s" row col))))

(defun my-org-insert-heading-for-next-day ()
  "Insert a same-level heading for the following day."
  (interactive)
  (let ((new-date
         (seconds-to-time
          (+ 86400.0
             (float-time
              (org-read-date nil 'to-time (elt (org-heading-components) 4)))))))
    (org-insert-heading-after-current)
    (insert (format-time-string "%Y-%m-%d\n\n" new-date))))

(defun my-org-contacts-template-email (&optional return-value)
  "Try to return the contact email for a template.
         If not found return RETURN-VALUE or something that would ask the user."
  (eval-when-compile (require 'gnus-art nil t))
  (eval-when-compile (require 'org-contacts nil t))
  (or (cadr (if (gnus-alive-p)
                (gnus-with-article-headers
                  (mail-extract-address-components
                   (or (mail-fetch-field "Reply-To") (mail-fetch-field "From") "")))))
      return-value
      (concat "%^{" org-contacts-email-property "}p")))

(defvar my-org-basic-task-template "* TODO %^{Task}
         :PROPERTIES:
         :Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}
         :END:
         Captured %<%Y-%m-%d %H:%M>
         %?

         %i
         " "Basic task data")
(defvar my-ledger-file "~/cloud/ledger/current.ledger")
(with-eval-after-load 'org-capture
  (setq org-capture-templates
        (seq-uniq
         (append

      `(("r" "Note" entry
         (file ,my-org-inbox-file)
         "* %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n%i\n\n- %a"
         :prepend t)
        ("t" "Task with annotation" entry
         (file ,my-org-inbox-file)
         "* TODO %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n%a\n"
         :prepend t)
        ("i" "Interrupting task" entry
         (file ,my-org-inbox-file)
         "* STARTED %^{Task}\n:PROPERTIES:\n:CREATED: %U\n:END:\n%a\n"
         :clock-in :clock-resume
         :prepend t)
        ("T" "Task without annotation" entry
         (file ,my-org-inbox-file)
         "* TODO %^{Task}\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n"
         :prepend t)
        ;; From https://takeonrules.com/2022/10/16/adding-another-function-to-my-workflow/
        ("c" "Contents to current clocked task"
         plain (clock)
         "%i%?"
         :empty-lines 1)
        ;; ("p" "Podcast log - timestamped" item
        ;;  (file+olp+datetree "~/sync/orgzly/timestamped.org")
        ;;  "%<%H:%M:%S,%3N> %^{Note}"
        ;;  :immediate-finish t)
        ;; ("b" "Plover note" table-line
        ;;  (file+headline "~/proj/plover-notes/README.org" "Brief notes")
        ;;  "| %^{Stroke} | %^{Translation} | %^{Note} |"
        ;;  :immediate-finish t)
        ;; ("c" "Plover review from clippy" table-line
        ;;  (file+headline "~/proj/plover-notes/README.org" "For review")
        ;;  "%(let ((last (my-clippy-last))) (format \"| %s | %s |\" (car last) (cdr last)))"
        ;;  :immediate-finish t)

        ("." "Today" entry
         (file ,my-org-inbox-file)
         "* TODO %^{Task}\nSCHEDULED: %t\n:PROPERTIES:\n:CREATED: %U\n:END:\n"
         :immediate-finish t)
        ("v" "Video" entry
         (file ,my-org-inbox-file)
         "* TODO %^{Task}  :video:\nSCHEDULED: %t\n"
         :immediate-finish t)
        ("e" "Errand" entry
         (file ,my-org-inbox-file)
         "* TODO %^{Task}  :errands:\n:PROPERTIES:\n:CREATED: %U\n:END:\n"
         :immediate-finish t)
        ("n" "Note" entry
         (file ,my-org-inbox-file)
         "* %^{Note}\n:PROPERTIES:\n:CREATED: %U\n:END:\n"
         :immediate-finish t)
        ("N" "Note" entry
         (file ,my-org-inbox-file)
         "* %^{Note}\n:PROPERTIES:\n:CREATED: %U\n:END:\n"
         :prepend t)
        ("s" "Screenshot" entry
         (file ,my-org-inbox-file)
         "* %^{Note}\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n[[file:%(my-latest-file my-screenshot-directory)]]\n"
         :prepend t)
        ("b" "Business task" entry
         (file+headline "~/personal/business.org" "Tasks")
         ,my-org-basic-task-template)
        ("j" "Journal entry" plain
         (file+olp+datetree "~/sync/orgzly/journal.org")
         "%K - %a\n%i\n%?\n"
         :unnarrowed t)
        ("db" "Done - Business" entry
         (file+headline "~/personal/business.org" "Tasks")
         "* DONE %^{Task}\nSCHEDULED: %^t\n%?")
        ("dp" "Done - People" entry
         (file+headline "~/personal/people.org" "Tasks")
         "* DONE %^{Task}\nSCHEDULED: %^t\n%?")
        ("dt" "Done - Task" entry
         (file+headline "~/sync/orgzly/organizer.org" "Inbox")
         "* DONE %^{Task}\nSCHEDULED: %^t\n%?")
        ("q" "Quick note" item
         (file+headline "~/sync/orgzly/organizer.org" "Quick notes"))
        ("l" "Ledger")
        ("lc" "Cash expense" plain
         (file ,my-ledger-file)
         "%(ledger-read-date \"Date: \") * %^{Payee}
             Expenses:Cash
             Expenses:%^{Account}  %^{Amount}
           ")
        ("lb" "BDO CAD" plain
         (file ,my-ledger-file)
         "%(ledger-read-date \"Date: \") * %^{Payee}
             Expenses:Play    $ %^{Amount}
             Assets:BDO
           ")
        ("lp" "BDO PHP" plain
         (file ,my-ledger-file)
         "%(ledger-read-date \"Date: \") * %^{Payee}
             Expenses:Play    PHP %^{Amount}
             Assets:BDO
           ")
        ("B" "Book" entry
         (file+datetree "~/personal/books.org" "Inbox")
         "* %^{Title}  %^g
           %i
           *Author(s):* %^{Author} \\\\
           *ISBN:* %^{ISBN}

           %?

           *Review on:* %^t \\
           %a
           %U"
         :clock-in :clock-resume)
        ("C" "Contact" entry (file "~/sync/orgzly/people.org")
         "* %(org-contacts-template-name)
:PROPERTIES:
:EMAIL: %(my-org-contacts-template-email)
:END:")
        ("y" "Yay Emacs" entry (file+headline "~/proj/stream/index.org" "Notes for this session")
         "* %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n

%i

%a
"))
      org-capture-templates))))
(bind-key "C-M-r" 'org-capture)



;;(bind-key (kbd "<f5>") 'org-capture)

(use-package git-link)
(bind-key "C-c c" 'jf/capture-region-contents-with-metadata)
(defun jf/capture-region-contents-with-metadata (start end parg)
  "Write selected text between START and END to currently clocked `org-mode' entry.

With PARG kill the content instead."
  (interactive "r\nP")
  (let ((text (jf/region-contents-get-with-metadata start end)))
    (if (car parg)
  (kill-new text)
      (org-capture-string (concat "-----\n" text) "c"))))
(defun jf/region-contents-get-with-metadata (start end)
      "Get the region contents between START and END and return an `org-mode' formatted string."
      (require 'magit)
      (require 'git-link)
      (let* ((file-name (buffer-file-name (current-buffer)))
       (org-src-mode (replace-regexp-in-string
          "-mode"
          ""
          (format "%s" major-mode)))
       (func-name (which-function))
       (type (if (derived-mode-p 'prog-mode) "SRC" "EXAMPLE"))
       (code-snippet (buffer-substring-no-properties start end))
       (file-base (file-name-nondirectory file-name))
       (line-number (line-number-at-pos (region-beginning)))
       (remote-link (when (magit-list-remotes)
          (progn
            (call-interactively 'git-link)
            (car kill-ring))))
       (initial-txt (if (null func-name)
            (format "From [[file:%s::%s][%s]]:"
              file-name
              line-number
              file-base)
          (format "From ~%s~ (in [[file:%s::%s][%s]]):"
            func-name
            file-name
            line-number
            file-base))))
  (format (concat "\n- Local :: %s"
      (when remote-link (format "\n- Remote :: %s" remote-link))
      "\n\n#+BEGIN_%s %s"
      "\n%s"
      "\n#+END_%s\n")
    initial-txt
    type
    org-src-mode
    code-snippet
    type)))

(require 'org-clock)
(defun my-org-entry-wpm ()
  (interactive)
  (save-restriction
    (save-excursion
      (org-narrow-to-subtree)
      (goto-char (point-min))
      (let* ((words (count-words-region (point-min) (point-max)))
             (minutes (org-clock-sum-current-item))
             (wpm (/ words minutes)))
        (message "WPM: %d (words: %d, minutes: %d)" wpm words minutes)
        (kill-new (number-to-string wpm))))))

(add-hook 'org-clock-in-prepare-hook
          'my-org-mode-ask-effort)

(defun my-org-mode-ask-effort ()
  "Ask for an effort estimate when clocking in."
  (unless (org-entry-get (point) "Effort")
    (let ((effort
           (completing-read
            "Effort: "
            (org-entry-get-multivalued-property (point) "Effort"))))
      (unless (equal effort "")
        (org-set-property "Effort" effort)))))

;; Get this from https://raw.github.com/chenfengyuan/elisp/master/next-spec-day.el
(load "~/elisp/next-spec-day.el" t)

(setq org-enforce-todo-dependencies t)
(setq org-track-ordered-property-with-tag t)
(setq org-agenda-dim-blocked-tasks t)

(defun my-org-clean-up-inbox ()
  "Archive all DONE tasks and sort the remainder by TODO order."
  (interactive)
  (with-current-buffer (find-file my-org-inbox-file)
    (my-org-archive-done-tasks 'file)
    (goto-char (point-min))
    (if (org-at-heading-p) (save-excursion (insert "\n")))
    (org-sort-entries nil ?p)
    (goto-char (point-min))
    (org-sort-entries nil ?o)
    (save-buffer)))

(defun my-org-archive-done-tasks (&optional scope)
  "Archive finished or cancelled tasks.
       SCOPE can be 'file or 'tree."
  (interactive)
  (org-map-entries
   (lambda ()
     (org-archive-subtree)
     (setq org-map-continue-from (outline-previous-heading)))
   "TODO=\"DONE\"|TODO=\"CANCELLED\"" (or scope (if (org-before-first-heading-p) 'file 'tree))))