Sacha Chua's Emacs configuration

;; -*- lexical-binding: t -*-
;; This sets up the load path so that we can override it
(setq warning-suppress-log-types '((package reinitialization)))  (package-initialize)
(add-to-list 'load-path "/usr/local/share/emacs/site-lisp")
(add-to-list 'load-path "~/vendor/org-mode/lisp")
(add-to-list 'load-path "~/vendor/org-mode/contrib/lisp")
(setq custom-file "~/.config/emacs/custom-settings.el")
(setq use-package-always-ensure t)
(load custom-file t)

(setq user-full-name "Sacha Chua"
      user-mail-address "sacha@sachachua.com")

(defvar my-laptop-p (or (equal (system-name) "sacha-x230") (equal (system-name) "sacha-p52")))
(defvar my-server-p (and (equal (system-name) "localhost") (equal user-login-name "sacha")))
(defvar my-phone-p (not (null (getenv "ANDROID_ROOT")))
  "If non-nil, GNU Emacs is running on Termux.")
(when my-phone-p (setq gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3"))
(global-auto-revert-mode)  ; simplifies syncing

(defun my-reload-emacs-configuration ()
  (interactive)
  (load-file "~/proj/.emacs.d/Sacha.el"))

(setq backup-directory-alist '(("." . "~/.config/emacs/backups")))
(with-eval-after-load 'tramp
  (setq tramp-backup-directory-alist nil))

(setq delete-old-versions -1)
(setq version-control t)
(setq vc-make-backup-files t)
(setq auto-save-file-name-transforms '((".*" "~/.config/emacs/auto-save-list/" t)))

(setq savehist-file "~/.config/emacs/savehist")
(savehist-mode 1)
(setq history-length t)
(setq history-delete-duplicates t)
(setq savehist-save-minibuffer-history 1)
(setq savehist-additional-variables
      '(kill-ring
        search-ring
        regexp-search-ring))

(tool-bar-mode -1)

(fset 'yes-or-no-p 'y-or-n-p)

(use-package miniedit
  :commands minibuffer-edit
  :init (miniedit-install))

(setq kill-ring-max 1000)

(defadvice kill-region (before slick-cut activate compile)
  "When called interactively with no active region, kill a single line instead."
  (interactive
   (if mark-active (list (region-beginning) (region-end))
     (list (line-beginning-position)
           (line-beginning-position 2)))))

  (use-package embark
    :after org
    :load-path "~/vendor/embark"
            ; :quelpa (embark :fetcher github :repo "oantolin/embark")
    :config
    (setq embark-prompter 'embark-keymap-prompter)
    (add-to-list 'embark-target-finders 'my-embark-org-element)
    (add-to-list 'embark-target-finders 'my-embark-subed-timestamp)
    (add-to-list 'embark-target-injection-hooks '(my-journal-post embark--allow-edit))
    (with-eval-after-load 'subed
      (defvar-keymap embark-subed-timestamp-actions
        :doc "Subed timestamp actions"
        :parent subed-mode-map
        "." #'my-subed-set-timestamp-to-mpv-position
        "w" #'my-subed-copy-timestamp-dwim
        "<up>" #'my-subed-adjust-timestamp/my-subed-adjust-timestamp-up
        "f" #'my-waveform-subed-show-after-time
        "<down>" #'my-subed-adjust-timestamp/my-subed-adjust-timestamp-down))
    (defvar-keymap embark-sketch-actions
      :doc "Org Mode sketch-related actions"
      :parent org-mode-map
      "o" #'my-sketch-insert-file-as-link
      "i" #'my-sketch-insert-file-as-link
      "v" #'my-geeqie-view)
    (defvar-keymap embark-journal-actions
      :doc "Journal"
      "e" #'my-journal-edit)
    (add-to-list 'embark-keymap-alist '(sketch . embark-sketch-actions))
    (add-to-list 'embark-keymap-alist '(subed-timestamp . embark-subed-timestamp-actions))
    (add-to-list 'embark-keymap-alist '(journal . embark-journal-actions))
    :bind
    (("C-." . embark-act)
     ("C-;" . embark-act)
     :map vertico-map
     (("M-e" . embark-export))
     :map minibuffer-local-map
     (("C-c e" . embark-act)
      ("M-e" . embark-export)
      ("C-;" . embark-act)
      ("C-<tab>" . embark-select)
      ("C-SPC" . (lambda () (interactive) (embark-select) (vertico-next))))
     :map embark-collect-mode-map
     (("C-c e" . embark-act)
      ("C-;" . embark-act)
      ("C-<tab>" . embark-select))
     :map embark-general-map
     (("j" . my-journal-post)
      ("m" . my-stream-message)
      ("M-w" . (lambda (s) (interactive "MString: ") (kill-new s))))
     :map embark-symbol-map
     ("r" . erefactor-rename-symbol-in-buffer)
     :map embark-url-map
     ("c" . my-caption-show)
     ))
  (with-eval-after-load 'embark-org
    (define-key embark-org-src-block-map
     "i" #'my-org-fix-block-indentation))

(setq prefix-help-command 'embark-prefix-help-command)

(my-execute-extended-command-from-list nil '(org-capture consult-buffer))

;;; Mostly the same as my/read-extended-command-from-list
(defun my-read-extended-command-from-list (list)
  "Read command name to invoke in `execute-extended-command'."
  (minibuffer-with-setup-hook
      (lambda ()
        (add-hook 'post-self-insert-hook
                  (lambda ()
                    (setq execute-extended-command--last-typed
                          (minibuffer-contents)))
                  nil 'local)
        (setq-local minibuffer-default-add-function
                    (lambda ()
                      ;; Get a command name at point in the original buffer
                      ;; to propose it after M-n.
                      (let ((def (with-current-buffer
                                     (window-buffer (minibuffer-selected-window))
                                   (and (commandp (function-called-at-point))
                                        (format "%S" (function-called-at-point)))))
                            (all (sort (minibuffer-default-add-completions)
                                       #'string<)))
                        (if def
                            (cons def (delete def all))
                          all)))))
    ;; Read a string, completing from and restricting to the set of
    ;; all defined commands.  Don't provide any initial input.
    ;; Save the command read on the extended-command history list.
    (completing-read
     (concat (cond
              ((eq current-prefix-arg '-) "- ")
              ((and (consp current-prefix-arg)
                    (eq (car current-prefix-arg) 4)) "C-u ")
              ((and (consp current-prefix-arg)
                    (integerp (car current-prefix-arg)))
               (format "%d " (car current-prefix-arg)))
              ((integerp current-prefix-arg)
               (format "%d " current-prefix-arg)))
             ;; This isn't strictly correct if `execute-extended-command'
             ;; is bound to anything else (e.g. [menu]).
             ;; It could use (key-description (this-single-command-keys)),
             ;; but actually a prompt other than "M-x" would be confusing,
             ;; because "M-x" is a well-known prompt to read a command
             ;; and it serves as a shorthand for "Extended command: ".
             "M-x ")
     (lambda (string pred action)
       (if (and suggest-key-bindings (eq action 'metadata))
           '(metadata
             (affixation-function . read-extended-command--affixation)
             (category . command))
         (complete-with-action action list string pred)))
     #'commandp t nil 'extended-command-history)))

;;; Mostly the same as execute-extended-command
(defun my-execute-extended-command-from-list (prefixarg &optional command-name typed)
  ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
  ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
  "Read a command name, then read the arguments and call the command.
To pass a prefix argument to the command you are
invoking, give a prefix argument to `execute-extended-command'."
  (declare (interactive-only command-execute))
  ;; FIXME: Remember the actual text typed by the user before completion,
  ;; so that we don't later on suggest the same shortening.
  (interactive
   (let ((execute-extended-command--last-typed nil))
     (list current-prefix-arg
           (if (and command-name (listp command-name))
               (my-read-extended-command-from-list command-name)
             (read-extended-command))
           execute-extended-command--last-typed)))
  ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
  (when (listp command-name)
    (let ((current-prefix-arg prefixarg) ; for prompt
          (execute-extended-command--last-typed nil))
      (setq command-name
            (if command-name
                (my/read-extended-command-from-list command-name)
              (read-extended-command)))
      (setq typed execute-extended-command--last-typed)))
  (let* ((function (and (stringp command-name) (intern-soft command-name)))
         (binding (and suggest-key-bindings
                       (not executing-kbd-macro)
                       (where-is-internal function overriding-local-map t))))
    (unless (commandp function)
      (error "`%s' is not a valid command name" command-name))
    ;; Some features, such as novice.el, rely on this-command-keys
    ;; including M-x COMMAND-NAME RET.
    (set--this-command-keys (concat "\M-x" (symbol-name function) "\r"))
    (setq this-command function)
    ;; Normally `real-this-command' should never be changed, but here we really
    ;; want to pretend that M-x <cmd> RET is nothing more than a "key
    ;; binding" for <cmd>, so the command the user really wanted to run is
    ;; `function' and not `execute-extended-command'.  The difference is
    ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506).
    (setq real-this-command function)
    (let ((prefix-arg prefixarg))
      (command-execute function 'record))
    ;; If enabled, show which key runs this command.
    ;; But first wait, and skip the message if there is input.
    (let* ((waited
            ;; If this command displayed something in the echo area;
            ;; wait a few seconds, then display our suggestion message.
            ;; FIXME: Wait *after* running post-command-hook!
            ;; FIXME: If execute-extended-command--shorter were
            ;; faster, we could compute the result here first too.
            (when (and suggest-key-bindings
                       (or binding
                           (and extended-command-suggest-shorter typed)))
              (sit-for (cond
                        ((zerop (length (current-message))) 0)
                        ((numberp suggest-key-bindings) suggest-key-bindings)
                        (t 2))))))
      (when (and waited (not (consp unread-command-events)))
        (unless (or (not extended-command-suggest-shorter)
                    binding executing-kbd-macro (not (symbolp function))
                    (<= (length (symbol-name function)) 2))
          ;; There's no binding for CMD.  Let's try and find the shortest
          ;; string to use in M-x.
          ;; FIXME: Can be slow.  Cache it maybe?
          (while-no-input
            (setq binding (execute-extended-command--shorter
                           (symbol-name function) typed))))
        (when binding
          (with-temp-message
              (format-message "You can run the command `%s' with %s"
                              function
                              (if (stringp binding)
                                  (concat "M-x " binding " RET")
                                (key-description binding)))
            (sit-for (if (numberp suggest-key-bindings)
                         suggest-key-bindings
                       2))))))))

(define-key-after global-map [menu-bar my-menu] (cons "Shortcuts" (make-sparse-keymap "Custom shortcuts")) 'tools)
(define-key global-map [menu-bar my-menu journal] '("Show journal entries" . my-show-missing-journal-entries))
(define-key global-map [menu-bar my-menu agenda] '("Org agenda" . (lambda () (interactive) (org-agenda nil "a"))))
(define-key global-map [menu-bar my-menu audio] '("Process audio" . (lambda () (interactive) (shell-command "~/bin/process-audio &"))))
(define-key global-map [menu-bar my-menu new-index-card] '("New index card" . (lambda () (interactive)
                                                                                (my-org-sketch-edit (my-prepare-index-card-template)))))

(add-hook 'text-mode-hook 'context-menu-mode)
(with-eval-after-load 'dired
  (add-hook 'dired-mode-hook 'context-menu-mode))
(add-hook 'shell-mode-hook 'context-menu-mode)

(defun my-def-rep-command (alist)
  "Return a lambda that calls the first function of ALIST.
      It sets the transient map to all functions of ALIST,
      allowing you to repeat those functions as needed."
  (let ((keymap (make-sparse-keymap))
        (func (cdar alist)))
    (mapc (lambda (x)
            (when x
              (define-key keymap (kbd (car x)) (cdr x))))
          alist)
    (lambda (arg)
      (interactive "p")
      (when func
        (funcall func arg))
      (set-transient-map keymap t))))

(use-package hydra :commands defhydra)
(use-package use-package-hydra)
(if my-laptop-p
    (use-package hydra-posframe
      :if my-laptop-p :after hydra
      :vc (:url "https://github.com/Ladicle/hydra-posframe")
      ))

(with-eval-after-load 'hydra
  (defhydra my-window-movement ()
    ("<left>" windmove-left)
    ("<right>" windmove-right)
    ("<down>" windmove-down)
    ("<up>" windmove-up)
    ("y" other-window "other")
    ("h" switch-window "switch-window")
    ("b" consult-buffer "buffer")
    ("f" find-file "file")
    ("F" find-file-other-window "other file")
    ("v" (progn (split-window-right) (windmove-right)))
    ("o" delete-other-windows :color blue)
    ("a" ace-window)
    ("s" ace-swap-window)
    ("d" delete-window "delete")
    ("D" ace-delete-window "ace delete")
    ("i" ace-maximize-window "maximize")
     ("q" nil)))

(with-eval-after-load 'hydra
  (defhydra my-shortcuts (:exit t)
    ("j" my-helm-journal "Journal")
    ("C" my-resolve-orgzly-syncthing "Conflicts")
    ("n" my-capture-timestamped-note "Note")
    ("c" my-org-categorize-emacs-news/body "Categorize")
    ("d" my-emacs-news-check-duplicates "Dupe")
    ("s" save-buffer "Save")
    ("f" my-file-shortcuts/body "File shortcut")
    ("+" text-scale-increase "Increase")
    ("-" text-scale-decrease "Decrease")
    ("G" gif-screencast-start-or-stop "GIF screencast")
    ("g" my-geeqie/body "Geeqie")
    ("r" my-record-ffmpeg-toggle-recording "Record screen")
    ("l" (my-toggle-or-create "*scratch*" (lambda () (switch-to-buffer (startup--get-buffer-create-scratch)))) "Lisp")
    ("e" eshell-toggle "Eshell")
    ("w" my-engine-dmode-hydra/body "Search web")
    ("E" my-emacs-news/body "Emacs News"))
  (keymap-global-set "<f5>" #'my-shortcuts/body)
  (defhydra my-emacs-news (:exit t)
    "Emacs News"
    ("f" (find-file "~/sync/emacs-news/index.org") "News")
    ("C" (find-file "~/proj/emacs-calendar/README.org") "Calendar")
    ("C" (find-file "/ssh:web:/var/www/emacslife.com/calendar/README.org" "Calendar on server"))
    ("d" my-emacs-news-check-duplicates "Dupe")
    ("c" my-org-categorize-emacs-news/body "Categorize")
    ("h" (my-org-update-link-description "HN") "Link HN")
    ("i" (my-org-update-link-description "Irreal") "Link Irreal")
    ("m" my-share-emacs-news "Mail")
    ("t" (browse-url "https://tweetdeck.twitter.com") "Twitter")))

(defun my-org-update-link-description (description)
  "Update the current link's DESCRIPTION."
  (interactive "MDescription: ")
  (let (link)
    (save-excursion
      (cond
       ((org-in-regexp org-link-bracket-re 1)
        (setq link (org-link-unescape (match-string-no-properties 1)))
        (delete-region (match-beginning 0) (match-end 0))
        (insert (org-link-make-string link description))
        (sit-for 0))
       ((or (org-in-regexp org-link-angle-re)
            (org-in-regexp org-link-plain-re))
        (setq link (org-unbracket-string "<" ">" (match-string 0)))
        (delete-region (match-beginning 0) (match-end 0))
        (insert (org-link-make-string link description))
        (sit-for 0))))))

(defun my-org-insert-link ()
  "Insert link."
  (interactive)
  (when (org-in-regexp org-link-bracket-re 1)
    (goto-char (match-end 0))
    (insert "\n"))
  (cond
   ((or (string-match (regexp-quote "*new toot*") (buffer-name))
        (derived-mode-p 'markdown-mode))
    (let ((url (read-string "URL: ")))
      (if (region-active-p)
          (let ((s (buffer-substring (region-beginning) (region-end))))
            (delete-region (region-beginning) (region-end))
            (insert (format "[%s](%s)"
                            (read-string "Title: " s)
                            url)))
        (insert (format "[%s](%s)"
                        (read-string "Title: " (my-page-title url))
                        url)))))
   (t (call-interactively 'org-insert-link))))

(defun my-switch-to-previous-buffer ()
  "Switch to previously open buffer.
      Repeated invocations toggle between the two most recently open buffers."
  (interactive)
  (switch-to-buffer (other-buffer (current-buffer) 1)))

(defun my-org-check-agenda ()
  "Peek at agenda."
  (interactive)
  (cond
   ((derived-mode-p 'org-agenda-mode)
    (if (window-parent) (delete-window) (bury-buffer)))
   ((get-buffer "*Org Agenda*")
    (switch-to-buffer-other-window "*Org Agenda*"))
   (t (org-agenda nil "a"))))

(defvar hydra-stack nil)

(defun my-hydra-push (expr)
  (push `(lambda () ,expr) hydra-stack))

(defun my-hydra-pop ()
  (interactive)
  (let ((x (pop hydra-stack)))
    (when x (funcall x))))

(defun my-hydra-go-and-push (expr)
  (push hydra-curr-body-fn hydra-stack)
  (prin1 hydra-stack)
  (funcall expr))

;; example (progn (hydra-b/body) (hydra-push '(hydra-a/body)))
;; or   ("q" hydra-pop "exit")

(use-package which-key :init (which-key-mode 1))
(use-package which-key-posframe :if my-laptop-p :init (which-key-posframe-mode 1))

(defun my-reset-transients ()
  (interactive)
  (setq overriding-terminal-local-map nil))

(defun my-key-chord-define (keymap keys command)
  "Define in KEYMAP, a key-chord of two keys in KEYS starting a COMMAND.
      \nKEYS can be a string or a vector of two elements. Currently only elements
      that corresponds to ascii codes in the range 32 to 126 can be used.
      \nCOMMAND can be an interactive function, a string, or nil.
      If COMMAND is nil, the key-chord is removed.

      MODIFICATION: Do not define the transposed key chord.
      "
  (if (/= 2 (length keys))
      (error "Key-chord keys must have two elements"))
  ;; Exotic chars in a string are >255 but define-key wants 128..255 for those
  (let ((key1 (logand 255 (aref keys 0)))
        (key2 (logand 255 (aref keys 1))))
    (define-key keymap (vector 'key-chord key1 key2) command)))
(fset 'key-chord-define 'my-key-chord-define)

(use-package key-chord
  :if my-laptop-p
  :hydra (my-key-chord-commands
          ()
          "Main"
          ("k" kill-sexp)
          ("h" my-org-jump :color blue)
          ("x" my-org-finish-previous-task-and-clock-in-new-one "Finish and clock in" :color blue)
          ("b" helm-buffers-list :color blue)
          ("f" find-file :color blue)
          ("a" my-org-check-agenda :color blue)
          ("c" (call-interactively 'org-capture) "capture" :color blue)
          ("t" (org-capture nil "T") "Capture task")
          ("." repeat)
          ("C-t" transpose-chars)
          ("o" my-org-off-my-computer :color blue)
          ("w" my-engine-mode-hydra/body "web" :exit t)
          ("m" imenu :color blue)
          ("i" my-capture-timestamped-note-with-screenshot :exit t)
          ("n" my-capture-timestamped-note "Timestamped note" :exit t)
          ("q" quantified-track :color blue)
          ("r" my-describe-random-interactive-function)
          ("l" org-insert-last-stored-link)
          ("L" my-org-insert-link))
  :init
  (setq key-chord-one-key-delay 0.16)
  (setq key-chord-two-keys-delay 0.002)
  (key-chord-define-global "uu" 'undo)
  (key-chord-define-global "jr" 'my-goto-random-char-hydra/my-goto-random-char)
  (key-chord-define-global "kk" 'kill-whole-line)
  (key-chord-define-global "et" 'my-stream-message)
  (key-chord-define-global "em" 'embark-act)
  (key-chord-define-global ".t" 'my-stream/body)
  (key-chord-define-global "jj" 'avy-goto-word-1)
  (key-chord-define-global "yy" 'my-window-movement/body)
  (key-chord-define-global "jw" 'switch-window)
  (key-chord-define-global "jl" 'avy-goto-line)
  (key-chord-define-global "j." 'join-lines/body)
  (key-chord-define-global "FF" 'find-file)
  (key-chord-define-global "qq" 'my-quantified-hydra/body)
  (key-chord-define-global "hh" 'my-key-chord-commands/body)
  (key-chord-define-global "xx" 'er/expand-region)
  (key-chord-define-global "  " 'my-insert-space-or-expand)
  (key-chord-define-global "vv" 'god-mode-all)
  (key-chord-define-global "JJ" 'my-switch-to-previous-buffer)
  (key-chord-mode -1)) ;; disable for now

(bind-key "C-t" 'my-key-chord-commands/body)

(use-package consult
  :load-path "~/vendor/consult"
  ;:quelpa (consult :fetcher github :repo "minad/consult")
  :after projectile
  :bind (("C-x r x" . consult-register)
         ("C-x r b" . consult-bookmark)
         ("C-c k" . consult-kmacro)
         ("C-x M-:" . consult-complex-command)     ;; orig. repeat-complet-command
         ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window
         ("C-x 5 b" . consult-buffer-other-frame)
         ("M-#" . consult-register-load)
         ("M-'" . consult-register-store)          ;; orig. abbrev-prefix-mark (unrelated)
         ("C-M-#" . consult-register)
         ("M-g o" . consult-outline)
         ("M-g h" . consult-org-heading)
         ("M-g a" . consult-org-agenda)
         ("M-g m" . consult-mark)
         ("C-x b" . consult-buffer)
         ("M-g M-g" . consult-goto-line)           ;; orig. goto-line
         ("M-g o" . consult-outline)
         ("M-g m" . consult-mark)
         ("M-g k" . consult-global-mark)
         ("M-g i" . consult-imenu)
         ("M-g I" . consult-project-imenu)
         ("M-g e" . consult-error)
         ;; M-s bindings (search-map)
         ("M-s f" . consult-find)
         ("M-s i" . consult-info)
         ("M-s L" . consult-locate)
         ("M-s g" . consult-grep)
         ("M-s G" . consult-git-grep)
         ("M-s r" . consult-ripgrep)
         ("M-s l" . consult-line)
         ("M-s m" . consult-multi-occur)
         ("M-s k" . consult-keep-lines)
         ("M-s u" . consult-focus-lines)
         ;; Isearch integration
         ("M-s e" . consult-isearch)
         ("M-g l" . consult-line)
         ("M-g L" . ace-link)
         ("M-s m" . consult-multi-occur)
         ("C-x c o" . consult-multi-occur)
         ("C-x c SPC" . consult-mark)
         :map isearch-mode-map
         ("M-e" . consult-isearch)                 ;; orig. isearch-edit-string
         ("M-s e" . consult-isearch)               ;; orig. isearch-edit-string
         ("M-s l" . consult-line))
  :init
  (setq register-preview-delay 0
        register-preview-function #'consult-register-format)
  :custom
  consult-preview-key '(:debounce 0.2 any)
  consult-narrow-key "<"
  :config
  (setq consult-project-root-function #'projectile-project-root))

  (use-package marginalia :quelpa (marginalia :fetcher github :repo "minad/marginalia")
    :init
    (marginalia-mode)
    :bind (:map minibuffer-local-completion-map
                ("M-m" . marginalia-cycle))
    :config
    (add-to-list 'marginalia-prompt-categories '("sketch" . sketch))
    (add-to-list 'marginalia-censor-variables "-api-key")
    (cl-pushnew #'marginalia-annotate-symbol-with-alias
          (alist-get 'command marginalia-annotator-registry))
    (cl-pushnew #'marginalia-annotate-symbol-with-alias
          (alist-get 'function marginalia-annotator-registry))
    (cl-pushnew #'marginalia-annotate-symbol-with-alias
          (alist-get 'symbol marginalia-annotator-registry)))

  (defun marginalia-annotate-alias (cand)
    "Annotate CAND with the function it aliases."
    (when-let ((sym (intern-soft cand))
               (alias (car (last (function-alias-p sym))))
               (name (and (symbolp alias) (symbol-name alias))))
      (format " (%s)" name)))

  (defun marginalia-annotate-symbol-with-alias (cand)
    "Annotate symbol CAND with its documentation string.
      Similar to `marginalia-annotate-symbol'."
    (when-let (sym (intern-soft cand))
      (concat
       (marginalia-annotate-binding cand)
       (marginalia--fields
        ((marginalia-annotate-alias cand) :face 'marginalia-function)
        ((marginalia--symbol-class sym) :face 'marginalia-type)
        ((cond
          ((fboundp sym) (marginalia--function-doc sym))
          ((facep sym) (documentation-property sym 'face-documentation))
          (t (documentation-property sym 'variable-documentation)))
         :truncate 1.0 :face 'marginalia-documentation)))))

(defun my-store-action-key+cmd (cmd)
  (setq keycast--this-command-keys (this-single-command-keys) keycast--this-command cmd))
(defun my-force-keycast-update (&rest _)
  (force-mode-line-update t))
(use-package keycast
  :if my-laptop-p
  :after embark
  :config (dolist (cmd '(embark-act embark-act-noexit embark-become))
            (advice-add cmd
                        :before #'my-force-keycast-update)))

(use-package
  embark
  :config
                                        ;(setq embark-prompter 'embark-completing-read-prompter)
  (advice-add 'embark-keymap-prompter :filter-return #'my-store-action-key+cmd)
  (add-to-list 'embark-target-injection-hooks '(my-stream-message embark--allow-edit)))

(defadvice face-attribute (around sacha activate)
  (if (symbolp (ad-get-arg 0))
      ad-do-it))

(defun sanityinc/adjust-opacity (frame incr)
  (let* ((oldalpha (or (frame-parameter frame 'alpha) 100))
         (newalpha (+ incr oldalpha)))
    (when (and (<= frame-alpha-lower-limit newalpha) (>= 100 newalpha))
      (modify-frame-parameters frame (list (cons 'alpha newalpha))))))
(keymap-global-set "C-M-8" (lambda () (interactive) (sanityinc/adjust-opacity nil -2)))
(keymap-global-set "C-M-9" (lambda () (interactive) (sanityinc/adjust-opacity nil 2)))
(keymap-global-set "C-M-0" (lambda () (interactive) (modify-frame-parameters nil `((alpha . 100)))))

(add-to-list 'display-buffer-alist
             '("\\`\\*\\(Warnings\\|Compile-Log\\)\\*\\'"
               (display-buffer-no-window)
               (allow-no-window . t)))

(defun my-add-face-text-property (start end attribute value)
  (interactive
   (let ((attribute (intern
                     (completing-read
                      "Attribute: "
                      (mapcar (lambda (o) (symbol-name (car o)))
                              face-attribute-name-alist)))))
     (list (point)
           (mark)
           attribute
           (read-face-attribute '(()) attribute))))
  (add-face-text-property start end (list attribute value)))

(defun my-face-text-larger (start end)
  (interactive "r")
  (add-face-text-property
   start end
   (list :height (floor (+ 50 (car (alist-get :height (get-text-property start 'face) '(100))))))))
(defun my-face-text-smaller (start end)
  (interactive "r")
  (add-face-text-property
   start end
   (list :height (floor (- (car (alist-get :height (get-text-property start 'face) '(100))) 50)))))

  (defvar-keymap my-face-text-property-mode-map
    "M-o p" #'my-add-face-text-property
    "M-o +" #'my-face-text-larger
    "M-o -" #'my-face-text-smaller)
  (define-minor-mode my-face-text-property-mode
    "Make it easy to modify face properties."
    :init-value nil
    (repeat-mode 1))
  (defvar-keymap my-face-text-property-mode-repeat-map
    :repeat t
    "+" #'my-face-text-larger
    "-" #'my-face-text-smaller)
  (dolist (cmd '(my-face-text-larger my-face-text-smaller))
    (put cmd 'repeat-map 'my-face-text-property-mode-repeat-map))

(defvar my-copy-append-string nil "String to append when copying.")
(defun my-copy-and-append (beg end append)
  (interactive
   (list
    (if (region-active-p) (region-beginning) (point-min))
    (if (region-active-p) (region-end) (point-max))
    (if current-prefix-arg (read-string "Append: ")
      my-copy-append-string)))
  (when append
    (setq my-copy-append-string append))
  (kill-new (concat (buffer-substring beg end) append)))

(use-package ace-link)

(use-package ace-window
  :config
  (setq aw-keys '(?a ?o ?e ?u ?h ?t ?n ?s))
  :bind
  ("M-o" . 'ace-window)
  ("C-x o" . 'ace-window)
  )

(use-package vundo)

;; `prot/window-single-toggle' is based on `windower' by Pierre
;; Neidhardt (ambrevar on GitLab)
(use-package emacs
  :config
  (defvar prot/window-configuration nil
    "Current window configuration.
Intended for use by `prot/window-monocle'.")

  (define-minor-mode prot/window-single-toggle
    "Toggle between multiple windows and single window.
This is the equivalent of maximising a window.  Tiling window
managers such as DWM, BSPWM refer to this state as 'monocle'."
    :lighter " [M]"
    :global nil
    (if (one-window-p)
        (when prot/window-configuration
          (set-window-configuration prot/window-configuration))
      (setq prot/window-configuration (current-window-configuration))
      (delete-other-windows)))

  (defun prot/kill-buffer-current (&optional arg)
    "Kill current buffer or abort recursion when in minibuffer."
    (interactive "P")
    (if (minibufferp)
        (abort-recursive-edit)
      (kill-buffer (current-buffer)))
    (when (and arg
               (not (one-window-p)))
      (delete-window)))
  :bind (("s-m" . prot/window-single-toggle)
         ("s-k" . prot/kill-buffer-current)))

(advice-add 'delete-other-windows
            :around (lambda (orig-fun &rest args)
                      (if (frame-root-window-p (selected-window))
                          (call-interactively 'winner-undo)
                        (let ((ignore-window-parameters t))
                          (apply orig-fun args)))))

(use-package scroll-other-window
  :vc (:url "https://gist.github.com/politza/3f46785742e6e12ba0d1a849f853d0b9")
  :commands sow-mode
  :init (sow-mode 1))

(use-package avy
  :if my-laptop-p
  :config
  (defun avy-action-exchange (pt)
    "Exchange sexp at PT with the one at point."
    (set-mark pt)
    (transpose-sexps 0))

  (add-to-list 'avy-dispatch-alist '(?e . avy-action-exchange))

  (defun avy-action-embark (pt)
    (save-excursion
      (goto-char pt)
      (embark-act))
    (select-window
     (cdr (ring-ref avy-ring 0)))
    t)
  (setf (alist-get ?. avy-dispatch-alist) 'avy-action-embark)
  :bind
  ("M-j" . avy-goto-char-timer)
  )

(use-package avy-zap
  :if my-laptop-p
  :config
  (setq avy-zap-forward-only t)
  (setq avy-keys '(?a ?o ?e ?u ?i ?d ?h ?t ?n ?s))
  :bind
  (("M-z" . avy-zap-up-to-char-dwim)
   ("M-Z" . avy-zap-to-char-dwim)))

(use-package winner
  :init
  (winner-mode 1))

(defcustom file-name-completions-sort-function #'files-sort-modification-time
  "Function for sorting the completion list of file names.
The function takes the list of file names as argument
and returns the sorted list."
  :type '(choice (function :tag "Sort Function") (const :tag "Natural Order" nil))
  :group 'files)

(defun files-sort-access-time (files)
  "Sort FILES list with respect to access time."
  (sort
   files
   (lambda (fn1 fn2)
     (time-less-p
      (file-attribute-access-time (file-attributes fn2))
      (file-attribute-access-time (file-attributes fn1))))))

(defun files-sort-modification-time (files)
  "Sort FILES list with respect to modification time."
  (sort
   files
   :key (lambda (f) (file-attribute-modification-time (file-attributes f)))
   :lessp #'time-less-p
   :reverse t))

(defun ad-completion-file-name-table (fun string pred action)
  "Add 'display-sort-function' to metadata.
If the completion action is metadata, add
`file-name-completions-sort-function' as display-sort-function.
Otherwise call FUN with STRING, PRED and ACTION as arguments."
  (if (and (functionp file-name-completions-sort-function)
           (eq action 'metadata))
      `(metadata
        (category . file)
        (cycle-sort-function . identity)
        (display-sort-function . ,file-name-completions-sort-function))
    (funcall fun string pred action)))

(advice-add 'completion-file-name-table :around #'ad-completion-file-name-table)

(defvar my-download-dir "~/Downloads")
(defun my-open-latest-download ()
  (interactive)
  (find-file (my-latest-file my-download-dir)))
(defun my-attach-and-link-latest-download ()
  (interactive)
  (org-attach-attach (my-latest-file my-download-dir) nil 'cp)
  (org-insert-link nil (caar org-stored-links)))

(defun my-link-latest-download ()
  (interactive)
  (org-insert-link nil (concat "file:" (my-latest-file my-download-dir))
                   (file-name-nondirectory (my-latest-file my-download-dir))))

(defun my-include-latest-download ()
  (interactive)
  (my-insert-file-as-org-include (my-latest-file my-download-dir)))

(defun my-copy-latest-download (dest &optional force)
  (interactive "FDestination: ")
  (copy-file (my-latest-file my-download-dir) dest force))
(defun my-download-dired ()
  (interactive)
  (dired my-download-dir "-lt"))

(defun my-helm-org-rifle-org-directory ()
  (interactive)
  (helm-org-rifle-directories (list org-directory) t))
(use-package helm-org-rifle
  :bind
  ("M-g r r" . helm-org-rifle)
  ("M-g r a" . helm-org-rifle-org-agenda-files)
  ("M-g r o" . helm-org-rifle-org-directory)
  )
(defun my-consult-recoll-without-emacs-news ()
  (interactive)
  (consult-recoll--open (consult-recoll--search "-\"Emacs News\" ")))
(use-package consult-recoll
  :config
  (setq consult-recoll-search-flags nil)
  :bind
  ("M-s S" . consult-recoll))

(setq ediff-split-window-function 'split-window-horizontally)
(setq ediff-window-setup-function 'ediff-setup-windows-plain)
(defvar my-ediff-last-windows nil)

(defun my-store-pre-ediff-winconfig ()
"Store `current-window-configuration' in variable `my-ediff-last-windows'."
(setq my-ediff-last-windows (current-window-configuration)))

(defun my-restore-pre-ediff-winconfig ()
"Restore window configuration to stored value in `my-ediff-last-windows'."
(set-window-configuration my-ediff-last-windows))

(add-hook 'ediff-before-setup-hook #'my-store-pre-ediff-winconfig)
(add-hook 'ediff-quit-hook #'my-restore-pre-ediff-winconfig)

(use-package hideshow
  :hook
  (prog-mode . hs-minor-mode)
  :bind
  ("C-<tab>" . hs-cycle)
  ("C-<iso-lefttab>" . hs-global-cycle)
  ("C-S-<tab>" . hs-global-cycle))
(defun hs-cycle (&optional level)
  (interactive "p")
  (let (message-log-max
        (inhibit-message t))
    (if (= level 1)
        (pcase last-command
          ('hs-cycle
           (hs-hide-level 1)
           (setq this-command 'hs-cycle-children))
          ('hs-cycle-children
           ;; TODO: Fix this case. `hs-show-block' needs to be
           ;; called twice to open all folds of the parent
           ;; block.
           (save-excursion (hs-show-block))
           (hs-show-block)
           (setq this-command 'hs-cycle-subtree))
          ('hs-cycle-subtree
           (hs-hide-block))
          (_
           (if (not (hs-already-hidden-p))
               (hs-hide-block)
             (hs-hide-level 1)
             (setq this-command 'hs-cycle-children))))
      (hs-hide-level level)
      (setq this-command 'hs-hide-level))))

(defun hs-global-cycle ()
    (interactive)
    (pcase last-command
      ('hs-global-cycle
       (save-excursion (hs-show-all))
       (setq this-command 'hs-global-show))
      (_ (hs-hide-all))))

(bind-key "C-x p" 'pop-to-mark-command)
(setq set-mark-command-repeat-pop t)

(use-package helm-swoop
  :if my-laptop-p
  :bind
  (("C-S-s" . helm-swoop)
   ("M-i" . helm-swoop)
   ("M-s M-s" . helm-swoop)
   ("M-I" . helm-swoop-back-to-last-point)
   ("C-c M-i" . helm-multi-swoop)
   ("C-x M-i" . helm-multi-swoop-all)
   )
  :config
  (progn
    (define-key isearch-mode-map (kbd "M-i") 'helm-swoop-from-isearch)
    (define-key helm-swoop-map (kbd "M-i") 'helm-multi-swoop-all-from-helm-swoop))
  )

(add-hook 'prog-mode-hook 'hl-line-mode)
(add-hook 'text-mode-hook 'hl-line-mode)

(defun my-suggest-other-faces (func &rest args)
  (if hl-line-mode
      (progn
        (hl-line-mode -1)
        (prog1 (apply func args)
          (hl-line-mode 1)))
    (apply func args)))
(advice-add #'face-at-point :around #'my-suggest-other-faces)

(use-package windmove
  :bind
  (("<f2> <right>" . windmove-right)
   ("<f2> <left>" . windmove-left)
   ("<f2> <up>" . windmove-up)
   ("<f2> <down>" . windmove-down)
   ))

(setq bookmark-watch-bookmark-file 'silent)
(defvar my-refile-map (make-sparse-keymap))
(require 'bookmark)
(defmacro my-defshortcut (key file)
  `(progn
     (set-register ,key (cons 'file ,file))
     (bookmark-store ,file (list (cons 'filename ,file)
                                 (cons 'position 1)
                                 (cons 'front-context-string "")) nil)
     (define-key my-refile-map
       (char-to-string ,key)
       (lambda (prefix)
         (interactive "p")
         (let ((org-refile-targets '(((,file) :maxlevel . 6)))
               (current-prefix-arg (or current-prefix-arg '(4))))
           (call-interactively 'org-refile))))))


(define-key my-refile-map "," 'my-org-refile-to-previous-in-file)

(defmacro defshortcuts (name body &optional docstring &rest heads)
  (declare (indent defun) (doc-string 3))
  (cond ((stringp docstring))
        (t
         (setq heads (cons docstring heads))
         (setq docstring "")))
  (list
   'progn
   (append `(defhydra ,name (:exit t))
           (mapcar (lambda (h)
                     (list (elt h 0) (list 'find-file (elt h 1)) (elt h 2)))
                   heads))
   (cons 'progn
         (mapcar (lambda (h) (list 'my-defshortcut (string-to-char (elt h 0)) (elt h 1)))
                 heads))))

(defmacro defshortcuts+ (name body &optional docstring &rest heads)
  (declare (indent defun) (doc-string 3))
  (cond ((stringp docstring))
        (t
         (setq heads (cons docstring heads))
         (setq docstring "")))
  (list
   'progn
   (append `(defhydra+ ,name (:exit t))
           (mapcar (lambda (h)
                     (list (elt h 0) (list 'find-file (elt h 1)) (elt h 2)))
                   heads))
   (cons 'progn
         (mapcar (lambda (h) (list 'my-defshortcut (string-to-char (elt h 0)) (elt h 1)))
                 heads))))

(use-package hydra
  :config
  (defshortcuts my-file-shortcuts ()
    ("C" "~/proj/emacs-calendar/README.org" "Emacs calendar")
    ("e" "~/sync/emacs/Sacha.org" "Config")
    ("E" "~/sync/emacs-news/index.org" "Emacs News")
    ("f" "~/proj/font/README.org" "Font")
    ("I" "~/sync/orgzly/computer-inbox.org" "Computer inbox")
    ("i" "~/sync/orgzly/Inbox.org" "Phone inbox")
    ("o" "~/sync/orgzly/organizer.org" "Main org file")
    ("s" "~/proj/stream/index.org" "Yay Emacs")
    ("b" "~/sync/orgzly/business.org" "Business")
    ("P" "/scp:web:/mnt/prev/home/sacha/planet/data/feeds.json" "Planet Emacsen")
    ("p" "~/sync/orgzly/posts.org" "Posts")
    ("m" "~/sync/web/beginner-map.org" "Map")
    ("n" "/ssh:web|sudo::/etc/nginx/sites-available" "Nginx sites")
    ("w" "~/Dropbox/public/sharing/index.org" "Sharing index")
    ("W" "~/Dropbox/public/sharing/blog.org" "Blog index")
    ("1" "~/proj/static-blog/" "Static blog")
    ("r" "~/sync/orgzly/reference.org" "Reference")
    ("R" "~/personal/reviews.org" "Reviews")
    ("v" "~/proj/emacstv.github.io/videos.org" "Videos")
    ("g" "~/proj/sachac.github.io/evil-plans/index.org" "Evil plans"))
  :bind
  ("C-c f" . #'my-file-shortcuts/body))

(defun prot/keyboard-quit-dwim ()
  "Do-What-I-Mean behaviour for a general `keyboard-quit'.

The generic `keyboard-quit' does not do the expected thing when
the minibuffer is open.  Whereas we want it to close the
minibuffer, even without explicitly focusing it.

The DWIM behaviour of this command is as follows:

- When the region is active, disable it.
- When a minibuffer is open, but not focused, close the minibuffer.
- When the Completions buffer is selected, close it.
- In every other case use the regular `keyboard-quit'."
  (interactive)
  (cond
   ((region-active-p)
    (keyboard-quit))
   ((derived-mode-p 'completion-list-mode)
    (delete-completion-window))
   ((> (minibuffer-depth) 0)
    (abort-recursive-edit))
   (t
    (keyboard-quit))))

(define-key global-map (kbd "C-g") #'prot/keyboard-quit-dwim)

(use-package smartscan
  :if my-laptop-p
  :defer t
  :config (global-smartscan-mode t))

(setq dired-listing-switches "-altr")
(setq dired-dwim-target 'dired-dwim-target-next)

(require 'find-dired)
(setq find-ls-option '("-print0 | xargs -0 ls -ld" . "-ld"))

(use-package dired-subtree
  :ensure t
  :after dired
  :bind
  ( :map dired-mode-map
    ("<tab>" . dired-subtree-toggle)
    ("TAB" . dired-subtree-toggle)
    ("<backtab>" . dired-subtree-remove)
    ("S-TAB" . dired-subtree-remove))
  :config
  (setq dired-subtree-use-backgrounds nil))

(defun my-smarter-move-beginning-of-line (arg)
  "Move point back to indentation of beginning of line.

      Move point to the first non-whitespace character on this line.
      If point is already there, move to the beginning of the line.
      Effectively toggle between the first non-whitespace character and
      the beginning of the line.

      If ARG is not nil or 1, move forward ARG - 1 lines first.  If
      point reaches the beginning or end of the buffer, stop there."
  (interactive "^p")
  (setq arg (or arg 1))

  ;; Move lines first
  (when (/= arg 1)
    (let ((line-move-visual nil))
      (forward-line (1- arg))))

  (let ((orig-point (point)))
    (back-to-indentation)
    (when (= orig-point (point))
      (move-beginning-of-line 1))))

;; remap C-a to `smarter-move-beginning-of-line'
(global-set-key [remap move-beginning-of-line]
                'my-smarter-move-beginning-of-line)

(require 'recentf)
(setq recentf-max-saved-items 200
      recentf-max-menu-items 15)
(recentf-mode)

(defun prelude-copy-file-name-to-clipboard ()
  "Copy the current buffer file name to the clipboard."
  (interactive)
  (let ((filename (if (equal major-mode 'dired-mode)
                      default-directory
                    (buffer-file-name))))
    (when filename
      (kill-new filename)
      (message "Copied buffer file name '%s' to the clipboard." filename))))

(defun prelude-open-with (arg)
  "Open visited file in default external program.

      With a prefix ARG always prompt for command to use."
  (interactive "P")
  (when buffer-file-name
    (shell-command (concat
                    (cond
                     ((and (not arg) (eq system-type 'darwin)) "open")
                     ((and (not arg) (member system-type '(gnu gnu/linux gnu/kfreebsd))) "xdg-open")
                     (t (read-shell-command "Open current file with: ")))
                    " "
                    (shell-quote-argument buffer-file-name)))))

(defun my-toggle-or-create (buffer-name buffer-create-fn &optional switch-cont)
  (interactive)
  (let ((target-buf (get-buffer buffer-name)))
    (prin1 target-buf)
    (cond
     ((equal (current-buffer) target-buf) (switch-to-buffer nil))
     (target-buf
      (switch-to-buffer target-buf)
      (if switch-cont (funcall switch-cont)))
     (t (funcall buffer-create-fn)
        (if switch-cont (funcall switch-cont))))))

(use-package link-hint
  :bind
  ("M-g u" . link-hint-open-link)
  ("M-g U" . link-hint-open-multiple-links))

(easy-menu-define cc/bookmarks-menu nil
  "Keymap for CC Bookmarks Menu"
  '("Bookmarks"
    ["Edit Bookmarks" list-bookmarks
     :help "Display a list of existing bookmarks."]
    ["--" nil]
    ["Add Bookmark…" bookmark-set-no-overwrite
     :help "Set a bookmark named NAME at the current location."]
    ["---" nil]
    ["Jump to Bookmark…" bookmark-jump
     :help "Jump to bookmark"]))
(easy-menu-add-item global-map '(menu-bar)
                    cc/bookmarks-menu
                    "Tools")
(defhydra+ my-shortcuts (:exit t)
  ("b" bookmark-jump "Jump to bookmark")
  ("B" bookmark-set-no-overwrite "Set bookmark"))

    ;; Install and load `quelpa-use-package'.
(use-package dogears
  ;; :quelpa (dogears :fetcher github :repo "alphapapa/dogears.el")

  ;; These bindings are optional, of course:
  :bind (:map global-map
              ("M-g d" . dogears-go)
              ("M-g M-b" . dogears-back)
              ("M-g M-f" . dogears-forward)
              ("M-g M-d" . dogears-list)
              ("M-g M-D" . dogears-sidebar)))

(defun my-goto-random-char ()
  (interactive)
  (goto-char (random (point-max))))

(when (eq system-type 'windows-nt)
  (setq tramp-default-method "plink")
  (setq tramp-auto-save-directory "c:\\sacha\\tmp"))

(defvar *my-previous-buffer* t
  "can we switch?")

(defun my-previous-buffer ()
  (interactive)
  (message "custom prev: *my-previous-buffer*=%s" *my-previous-buffer*)
  (when *my-previous-buffer*
    (previous-buffer)
    (setq *my-previous-buffer* nil)
    (run-at-time "1 sec" nil (lambda ()
                               (setq *my-previous-buffer* t)))))

(defvar *my-next-buffer* t
  "can we switch?")

(defun my-next-buffer ()
  (interactive)
  (message "custom prev: *my-next-buffer*=%s" *my-next-buffer*)
  (when *my-next-buffer*
    (next-buffer)
    (setq *my-next-buffer* nil)
    (run-at-time "1 sec" nil (lambda ()
                               (setq *my-next-buffer* t)))))

(keymap-global-set "<triple-wheel-right>" 'my-previous-buffer)
(keymap-global-set "<triple-wheel-left>" 'my-next-buffer)

(defun my-gif-screencast-start-or-stop-and-choose-thumbnail ()
  "Start a screencast or pause recording."
  (interactive)
  (if gif-screencast-mode
      (progn
        (gif-screencast-toggle-pause)
        (dired gif-screencast-screenshot-directory)
        (revert-buffer)
        (dired gif-screencast-screenshot-directory)
        (image-dired gif-screencast-screenshot-directory))
    (gif-screencast)))

(defun my-gif-screencast-copy-image-to-first-frame (file)
  (interactive (list (dired-get-filename)))
  ;; Determine the timestamp of the first file in this directory
  (copy-file
   file
   (expand-file-name
    (format-time-string
     "screen-%F-%T-%3N.png"
     (time-subtract
      (my-gif-screencast-timestamp-from-filename
       (car (directory-files gif-screencast-screenshot-directory nil ".png")))
      (seconds-to-time 0.001)))
    gif-screencast-screenshot-directory)))

(defun my-gif-screencast-timestamp-from-filename (file)
  (setq file (replace-regexp-in-string "^screen-" "" (file-name-base file)))
  (time-add (date-to-time (format "%s %s" (substring file 0 10) (substring file 11 19)))
            (float-time (/ (string-to-number (substring file 20 23)) 1000.0))))
(cl-assert
 (string= (format-time-string "test-%F-%T-%3N" (my-gif-screencast-timestamp-from-filename "screen-2024-09-20-13:18:08-024.png"))
          "test-2024-09-20-13:18:08-024"))

(defun my-gif-screencast-update-frames-from-directory ()
  (interactive)
  (let* ((files (directory-files gif-screencast-screenshot-directory nil ".png"))
         (start-time (my-gif-screencast-timestamp-from-filename (car files))))
    (setq gif-screencast--frames
          (mapcar (lambda (o)
                    (make-gif-screencast-frame
                     :timestamp (my-gif-screencast-timestamp-from-filename o)
                     :filename o))
                  files))
    (gif-screencast-mode 0)
    (gif-screencast--finish)))

(use-package gif-screencast
  :bind
  ("s-s" . my-gif-screencast-start-or-stop-and-choose-thumbnail)
  :config
  (setq gif-screencast-output-directory my-recordings-dir))

(use-package giffy
  :quelpa (giffy :fetcher github :repo "larsmagne/giffy"))

(setq sentence-end-double-space nil)

(use-package writeroom-mode
  :config
  (setq writeroom-global-effects (remove 'writeroom-set-fullscreen
                                         writeroom-global-effects)))

(defun my-redact (s)
  "Replace S with x characters."
  (make-string (length s) ?x))

(defun my-redact-region (beg end &optional func)
  "Redact from BEG to END."
  (interactive "r")
  (let ((overlay (make-overlay beg end)))
    (overlay-put overlay 'redact t)
    (overlay-put overlay 'display
                 (cond
                  ((functionp func)
                   (funcall func))
                  ((stringp func)
                   func)
                  (t (make-string (- end beg) ?x))))))

(defun my-redact-regexp-replacement (regexp replacement &optional beg end)
  "Redact buffer content matching regexp."
  (interactive (list (read-regexp "Redact regexp: " 'regexp-history-last)
                     (read-string "Replacement (ex: \\1 \\,(my-redact \\2)): ")))
  (setq beg (or beg (point-min)))
  (setq end (or end (point-max)))
  (when (stringp replacement)
    (setq replacement (query-replace-compile-replacement replacement t)))
  (save-excursion
    (goto-char beg)
    (while (re-search-forward regexp end t)
      (my-redact-region
       (match-beginning 0) (match-end 0)
       (with-temp-buffer
         (insert (match-string 0))
         (goto-char (point-min))

         )
       (replace-regexp-in-string regexp replacement (match-string 0))))))

(defun my-redact-regexp (regexp &optional beg end func)
  "Redact buffer content matching regexp."
  (interactive (list (string-trim (read-regexp "Redact regexp: " 'regexp-history-last))))
  (save-excursion
    (goto-char (or beg (point-min)))
    (while (re-search-forward regexp (or end (point-max)) t)
      (my-redact-region (match-beginning 0) (match-end 0) func))))

(defun my-unredact ()
  (interactive)
  (mapc 'delete-overlay
        (seq-filter (lambda (overlay) (overlay-get overlay 'redact))
                    (overlays-in (point-min) (point-max)))))

(defun my-redact-email-string (s)
  (replace-regexp-in-string
   "\\([-+_~a-zA-Z0-9][-+_.~:a-zA-Z0-9]*\\)@\\([-a-zA-Z0-9]+[-.a-zA-Z0-9]*\\)"
   (lambda (sub)
     (concat
      (make-string (length (match-string 1 sub)) ?x)
      "@"
      (make-string (length (match-string 2 sub)) ?x)))
   s))

(defun my-redact-emails (&rest _)
  (interactive)
  (my-redact-regexp
   "\\([-+_~a-zA-Z0-9][-+_.~:a-zA-Z0-9]*\\)@\\([-a-zA-Z0-9]+[-.a-zA-Z0-9]*\\)"
   nil nil
   (lambda () (my-redact-email-string (match-string 0)))))

(defun my-redact-emacsconf-org ()
  (interactive)
  (my-redact-regexp-replacement
   "\\(^:EMAIL:[ \t]+\\)\\(.+\\)"
   "\\1 \\,(my-redact \\2)"
   ))
(defun my-redact-tabulated-list-in-rectangle (regexp beg end)
  ;; tabulated columns use substrings with display properties
  ;; so we should skip any characters that have text-property-any 'display
  (interactive (list (read-regexp "Redact regexp: " 'regexp-history-last)
                     (min (point) (mark))
                     (max (point) (mark))))
  (apply-on-rectangle
   (lambda (start-col end-col)
     (let ((start-pos (and (move-to-column start-col) (point)))
           (end-pos (and (move-to-column end-col) (point)))
           display-prop)
       (save-restriction
         (narrow-to-region start-pos end-pos)
         (goto-char start-pos)
         (setq display-prop (text-property-search-forward 'display))
         (if display-prop
             (while display-prop
               (my-redact-regexp regexp start-pos (prop-match-beginning display-prop))
               (setq start-pos (prop-match-end display-prop))
               (setq display-prop (text-property-search-forward 'display)))
           (my-redact-regexp regexp start-pos end-pos)))))
   beg end))

(defun my-redact-regexp-in-rectangle (regexp beg end)
  (interactive (list (read-regexp "Redact regexp: " 'regexp-history-last)
                     (min (point) (mark))
                     (max (point) (mark))))
  (apply-on-rectangle (lambda (start-col end-col)
                        (my-redact-regexp regexp
                                          (and (move-to-column start-col) (point))
                                          (and (move-to-column end-col) (point))))
                      beg end))

(advice-add
 #'notmuch-show
 :after #'my-redact-emails)

00:20:18.680 --> 00:20:24.679
So, right now, What's my current state? Uh,

NOTE CHAPTER: second brain

00:20:24.680 --> 00:20:30.719
START CHAPTER second brain STOP CHAPTER

(defun my-whisperx-word-list (file)
  (let* ((json-object-type 'alist)
         (json-array-type 'list))
    (seq-mapcat (lambda (seg)
                  (alist-get 'words seg))
                (alist-get 'segments (json-read-file file)))))

;; (seq-take (my-whisperx-word-list (my-latest-file "~/sync/recordings" "\\.json")) 10)
(defun my-whisperx-insert-word-list (words)
  "Inserts WORDS with text properties."
  (require 'subed-word-data)
  (mapc (lambda (word)
            (let ((start (point)))
              (insert
               (alist-get 'word word))
              (subed-word-data--add-word-properties start (point) word)
              (insert " ")))
        words))

(defun my-audio-braindump-turn-sections-into-headings ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "START SECTION \\(.+?\\) STOP SECTION" nil t)
    (replace-match
     (save-match-data
       (format
        "\n*** %s\n"
        (save-match-data (string-trim (replace-regexp-in-string "^[,\\.]\\|[,\\.]$" "" (match-string 1))))))
     nil t)
    (let ((prop-match (save-excursion (text-property-search-forward 'subed-word-data-start))))
      (when prop-match
        (org-entry-put (point) "START" (format-seconds "%02h:%02m:%02s" (prop-match-value prop-match)))))))

(defun my-audio-braindump-split-sentences ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "[a-z]\\. " nil t)
    (replace-match (concat (string-trim (match-string 0)) "\n") )))

(defun my-audio-braindump-restructure ()
  (interactive)
  (goto-char (point-min))
  (my-subed-fix-common-errors)
  (org-mode)
  (my-audio-braindump-prepare-alignment-breaks)
  (my-audio-braindump-turn-sections-into-headings)
  (my-audio-braindump-split-sentences)
  (goto-char (point-min))
  (my-remove-filler-words-at-start))

(defun my-audio-braindump-from-whisperx-json (file)
  (interactive (list (read-file-name "JSON: " "~/sync/recordings/" nil nil nil (lambda (f) (string-match "\\.json\\'" f)))))
  ;; put them all into a buffer
  (with-current-buffer (get-buffer-create "*Words*")
    (erase-buffer)
    (fundamental-mode)
    (my-whisperx-insert-word-list (my-whisperx-word-list file))
    (my-audio-braindump-restructure)
    (goto-char (point-min))
    (switch-to-buffer (current-buffer))))

(defun my-audio-braindump-process-text (file)
  (interactive (list (read-file-name "Text: " "~/sync/recordings/" nil nil nil (lambda (f) (string-match "\\.txt\\'" f)))))
  (with-current-buffer (find-file-noselect file)
    (my-audio-braindump-restructure)
    (save-buffer)))
;; (my-audio-braindump-from-whisperx-json (my-latest-file "~/sync/recordings" "\\.json"))

(use-package markdown-mode
  :if my-laptop-p
  :mode ("\\.\\(njk\\|md\\)\\'" . markdown-mode))

(defun screenshot-svg ()
  "Save a screenshot of the current frame as an SVG image.
Saves to a temp file and puts the filename in the kill ring."
  (interactive)
  (let* ((filename
          (expand-file-name
           (format-time-string "%Y-%m-%d-%H-%M-%S.svg")
           my-recordings-dir))
         (data (x-export-frames nil 'svg)))
    (with-temp-file filename
      (insert data))
    (kill-new filename)
    (message filename)))
(keymap-global-set "C-c s" #'screenshot-svg)

(use-package artbollocks-mode
  :if my-laptop-p
  :defer t
  :load-path  "~/elisp/artbollocks-mode"
  :config
  (progn
    (setq artbollocks-weasel-words-regex
          (concat "\\b" (regexp-opt
                         '("one of the"
                           "should"
                           "just"
                           "sort of"
                           "a lot"
                           "probably"
                           "maybe"
                           "perhaps"
                           "I think"
                           "really"
                           "pretty"
                           "nice"
                           "action"
                           "utilize"
                           "leverage") t) "\\b"))
    ;; Don't show the art critic words, or at least until I figure
    ;; out my own jargon
    (setq artbollocks-jargon nil)))

(defun my-unfill-paragraph (&optional region)
  "Takes a multi-line paragraph and makes it into a single line of text."
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (list t)))
  (let ((fill-column (point-max)))
    (fill-paragraph nil region)))
(bind-key "M-Q" 'my-unfill-paragraph)

(defun my-fill-or-unfill-paragraph (&optional unfill region)
  "Fill paragraph (or REGION).
        With the prefix argument UNFILL, unfill it instead."
  (interactive (progn
                 (barf-if-buffer-read-only)
                 (list (if current-prefix-arg 'unfill) t)))
  (let ((fill-column (if unfill (point-max) fill-column)))
    (fill-paragraph nil region)))
(bind-key "M-q" 'my-fill-or-unfill-paragraph)

(remove-hook 'text-mode-hook #'turn-on-auto-fill)
(add-hook 'text-mode-hook 'turn-on-visual-line-mode)

(defmacro my-insert-unicode (unicode-name)
  `(lambda () (interactive)
     (insert-char (cdr (assoc-string ,unicode-name (ucs-names))))))
(bind-key "C-x 8 s" (my-insert-unicode "ZERO WIDTH SPACE"))
(bind-key "C-x 8 S" (my-insert-unicode "SNOWMAN"))

(bind-key "M-SPC" 'cycle-spacing)

(setq save-abbrevs 'silently)
(bind-key "M-/" 'hippie-expand)

(defun sanityinc/dabbrev-friend-buffer (other-buffer)
  (< (buffer-size other-buffer) (* 1 1024 1024)))
(setq dabbrev-friend-buffer-function 'sanityinc/dabbrev-friend-buffer)

(setq hippie-expand-try-functions-list
      '(yas-hippie-try-expand
        try-expand-all-abbrevs
        try-complete-file-name-partially
        try-complete-file-name
        try-expand-dabbrev
        try-expand-dabbrev-from-kill
        try-expand-dabbrev-all-buffers
        try-expand-list
        try-expand-line
        try-complete-lisp-symbol-partially
        try-complete-lisp-symbol))

;; hmm, doesn't quite work for looking things up yet. I basically want a programmatic where-is for a specific keymap
(defvar my-keybinding-maps '(subed-mode-map subed-waveform-minor-mode-map subed-waveform-svg-map))
(defun my-copy-keybinding (symbol)
  (interactive (list (find-function-read)))
  (when (listp symbol)
    (setq symbol (car symbol)))
  (let (result keys)
    (map-keymap
     (lambda (event def)
       (cond ((and (symbolp def))
              (push (list def event) result))
             ((and (listp def) (eq 'keymap (car def)))
              (apply 'append
                     (map-keymap
                      (lambda (event def)
                        (when (and (symbolp def))
                          (push (list def event) result)))
                      def)))))
     subed-mode-map)
    (setq keys (assoc-default symbol result))
    (when keys
      (kill-new (key-description keys))
      (message "%s" (key-description keys)))))

(defvar my-audio-braindump-dir "~/sync/Phone")
(defun my-open-latest-braindump ()
  (interactive)
  (find-file (my-latest-file my-audio-braindump-dir "\\.txt"))
  (kill-new (buffer-string)))

(defun my-insert-latest-braindump ()
  (interactive)
  (insert-file-contents (my-latest-file my-audio-braindump-dir "\\.txt")))
(defun my-audio-braindump-dired ()
  (interactive)
  (dired my-audio-braindump-dir "-lt"))
(defalias 'my-phone-dired #'my-audio-braindump-dired)

(prefer-coding-system 'utf-8)
(when (display-graphic-p)
  (setq x-select-request-type '(UTF8_STRING COMPOUND_TEXT TEXT STRING)))

(defvar my-wdiff-mode-font-lock-keywords
  `(("{\\+\\(.*?\\)\\+}" . 'diff-added)
    ("\\[\\-\\(.*?\\)\\-\\]" . 'diff-removed)))

(defconst my-wdiff-mode-font-lock-defaults
  '(my-wdiff-mode-font-lock-keywords t nil nil nil (font-lock-multiline . t)))

(define-derived-mode my-wdiff-mode fundamental-mode "Word diff" "Highlight word diffs."
  (setq-local font-lock-defaults my-wdiff-mode-font-lock-defaults))

(defun my-wdiff (old-file new-file)
  (interactive (list (read-file-name "Original: ")
                     (buffer-file-name)))
  (with-current-buffer (get-buffer-create "*wdiff*")
    (erase-buffer)
    (call-process "wdiff" nil t t (expand-file-name old-file)
                  (expand-file-name new-file))
    (goto-char (point-min))
    (my-wdiff-mode)
    (switch-to-buffer (current-buffer))))

(defun my-wdiff-buffer-with-file ()
  (interactive)
  (let ((s (buffer-string))
        (temp-file (make-temp-file "temp")))
    (with-temp-file temp-file
      (insert s))
    (my-wdiff (buffer-file-name) temp-file)
    (delete-file temp-file)))

(use-package denote
  :config
  (setopt denote-directory "~/sync/Notes")
)

(defun my-insert-sketch-and-text (sketch)
  (interactive (list (my-complete-sketch-filename)))
  (insert
   (if (string= (file-name-extension sketch) "svg")
       (format
        "#+begin_panzoom\n%s\n#+end_panzoom\n\n"
        (org-link-make-string (concat "file:" sketch)))
     (concat (org-link-make-string (concat "sketchFull:" (file-name-base sketch))) "\n\n")))
  (let ((links (my-org-links-from-file (concat (file-name-sans-extension sketch) ".txt")))
        (subheading-level (1+ (org-current-level))))
    (insert (if links
                "#+begin_my_details Text and links from sketch\n"
              "#+begin_my_details Text from sketch\n"))
    (my-sketch-insert-text sketch)
    (unless (bolp) (insert "\n"))
    (insert "#+end_my_details")
    (dolist (section (seq-filter (lambda (entry) (string-match "^#" (cdr entry)))
                                 links))
      (org-end-of-subtree)
      (insert "\n\n")
      (org-insert-heading nil nil subheading-level)
      (insert (car section))
      (org-entry-put (point) "CUSTOM_ID" (substring (cdr section) 1)))))

(defun my-write-about-sketch (sketch)
  (interactive (list (my-complete-sketch-filename)))
  ;(shell-command "make-sketch-thumbnails")
  (find-file "~/sync/orgzly/posts.org")
  (goto-char (point-min))
  (unless (org-at-heading-p) (outline-next-heading))
  (org-insert-heading nil nil t)
  (insert (file-name-base sketch) "\n\n")
  (my-insert-sketch-and-text sketch)
  (insert "\nFeel free to use this under the [[https://creativecommons.org/licenses/by/4.0/][Creative Commons Attribution License]].\n")
  (delete-other-windows)
  (save-excursion
    (with-selected-window (split-window-horizontally)
      (find-file sketch))))

(defun my-org-delete-open-clocks ()
  (interactive)
  (flush-lines
   (rx
    line-start
    (zero-or-more space)
    "CLOCK:"
    (one-or-more space)
    (regexp org-ts-regexp-inactive)
    (zero-or-more space)
    line-end)))

(defun my-embark-org-insert-link-from-path (path)
  (interactive (list (car (org-refile-get-location))))
  (let* ((extra (if org-refile-use-outline-path "/" ""))
         (tbl (mapcar
               (lambda (x)
                 (if (and (not (member org-refile-use-outline-path
                                       '(file full-file-path title)))
                          (not (equal filename (file-truename (nth 1 x)))))
                     (cons (concat (car x) extra " ("
                                   (file-name-nondirectory (nth 1 x)) ")")
                           (cdr x))
                   (cons (concat (car x) extra) (cdr x))))
               org-refile-target-table))
         link)
    (insert (save-window-excursion
              (save-excursion
                (org-goto-marker-or-bmk
                 (elt
                  (org-refile--get-location path tbl)
                  3))
                (org-store-link nil))))))
(defvar-keymap my-org-path-map
  :doc "Shortcuts for working with Org paths from `org-refile'."
  "i" #'my-embark-org-insert-link-from-path
  "L" #'my-embark-org-insert-link-from-path)
(with-eval-after-load 'marginalia
  (add-to-list 'marginalia-prompt-categories '("Goto\\|Refile" . my-org-path)))
(with-eval-after-load 'embark
  (add-to-list 'embark-keymap-alist '(my-org-path . my-org-path-map)))

(with-eval-after-load 'consult-org
  (keymap-set embark-org-heading-map "L" #'embark-org-insert-link-to))

(defun my-org-map-blog-and-image-urls ()
  "Extract and map blog post / image URLs."
  (interactive)
  (goto-char (point-min))
  (keep-lines "h2\\|img")
  (goto-char (point-min))
  (while (re-search-forward
          "^.*?h2.*?a href=\"\\(.*?\\)\".*$" nil t)
    (replace-match "\\1"))
  (goto-char (point-min))
  (while (re-search-forward
          "^.*?src=\"\\(.*?\\)\".*$" nil t)
    (replace-match "\\1"))
  (let (last-post current-url result)
    (goto-char (point-min))
    (while (re-search-forward "http://\\(.*\\)" nil t)
      (setq current-url (match-string 0))
      (if (string-match "/\\([^/]*?\\)\\(_thumb\\|-640x.*\\)?.png" current-url)
          (setq result (cons (concat (match-string 1 current-url) "\t" last-post) result))
        (setq last-post current-url)))
    (kill-new (mapconcat 'identity result "\n"))))