path: root/attic/elisp/misc.el

;;;  -*- lexical-binding: t; -*-

;;; ace window
(use-package ace-window
  :ensure t
  :demand t
  :init (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
              aw-char-position 'top-left
              aw-ignore-current nil
              aw-dispatch-when-more-than 2
              aw-leading-char-style 'path
              aw-display-mode-overlay t
              aw-scope 'frame)
  :config

  (defun jao-ace-consult-buffer-other-window (w)
    (interactive)
    (aw-switch-to-window w)
    (consult-buffer))

  (setf (alist-get ?b aw-dispatch-alist)
        '(jao-ace-consult-buffer-other-window "Consult buffer"))

  (setf (alist-get ?B aw-dispatch-alist)
        (alist-get ?u aw-dispatch-alist))


  :bind (("M-o" . ace-window)
         ("M-O" . ace-swap-window)
         ("C-x 4 t" . ace-swap-window)))

;;; deft
(use-package deft
  :ensure t
  :after jao-org-notes
  :commands deft
  :init (setq deft-extensions '("org" "md")
              deft-directory jao-org-notes-dir
              deft-use-filename-as-title nil
              deft-use-filter-string-for-name t
              deft-file-naming-rules '((noslash . "-")
                                       (nospace . "-")
                                       (case-fn . downcase))
              deft-org-mode-title-prefix t
              deft-recursive t
              deft-recursive-ignore-dir-regexp (regexp-opt '("." ".." "attic"))
              deft-strip-summary-regexp
              (concat "\\([\n\t]"
                      "\\|^#\\+\\(title\\|created\\|date\\|author\\):.*$"
                      "\\|^#\\+\\(file\\)?tags: *\\)"))
  :config (setq deft-strip-title-regexp
                (concat "\\(^#\\+title: *\\)\\|" deft-strip-title-regexp))
  :bind (("<f9>" . deft)))

;;; detached
(use-package detached
  :ensure t
  :init
  (detached-init)
  :config
  (transient-define-prefix jao-transient-detached ()
    ["Detached sessions"
     ("v" "view session output" detached-view-session)
     ("a" "attach to a session" detached-attach-session)
     ("=" "diff a session with another session" detached-diff-session)
     ("c" "open the session output in compilation mode" detached-compile-session)
     ("r" "rerun a session" detached-rerun-session)
     ("i" "insert the session's command at point" detached-insert-session-command)
     ("w" "copy the session's shell command" detached-copy-session-command)
     ("W" "copy the session's output" detached-copy-session)
     ("k" "kill an active session" detached-kill-session)])

  :bind (;; Replace `async-shell-command' with `detached-shell-command'
         ([remap async-shell-command] . detached-shell-command)
         ;; Replace `compile' with `detached-compile'
         ([remap compile] . detached-compile)
         ([remap recompile] . detached-compile-recompile)
         ;; Replace built in completion of sessions with `consult'
         ([remap detached-open-session] . detached-consult-session)
         ("s-d" . jao-transient-detached))
  :custom ((detached-show-output-on-attach t)
           (detached-terminal-data-command system-type)))

(defun jao-detached-exec (command)
  (if (fboundp 'detached-create-session)
      (detached-create-session command)
    (jao-shell-exec command)))

;;; time display
(setq display-time-world-list
      '(("Europe/Paris" "Barcelona")
        ("America/Los_Angeles" "Los Angeles")
        ("America/New_York" "New York")
        ("Europe/London" "London")
        ("Asia/Calcutta" "Bangalore")
        ("Asia/Tokyo" "Tokyo")))

(defun jao-time--pdt-hour ()
  (jao-time-at-zone "%H" "America/Los_Angeles"))

(defun jao-time--chicago-hour ()
  (jao-time-at-zone "%H" "America/Chicago"))

(defun jao-time-at-zone (format zone)
  (set-time-zone-rule zone)
  (prog1 (format-time-string format)
    (set-time-zone-rule nil)))

(defun jao-time-echo-la-time ()
  (interactive)
  (message (jao-time-at-zone "LA %H:%M" "America/Los_Angeles")))

(defun jao-time-echo-times ()
  (interactive)
  (let ((msg (format "%s (%s)"
                     (format-time-string "%a, %e %B - %H:%M")
                     (jao-time-at-zone "%H:%M" "America/Los_Angeles"))))
    (jao-notify msg "" (jao-data-file "clock-world-icon.png"))))

(defun jao-time-to-epoch (&optional s)
  "Transform a time string to an epoch integer in milliseconds."
  (interactive)
  (let ((s (or s (read-string "Time string: " (thing-at-point 'string)))))
    (message "%s = %s"
             s
             (round (* 1000 (time-to-seconds (parse-time-string s)))))))

(defun jao-epoch-to-time (&optional v)
  "Transform an epoch, given in milliseconds, to a time string."
  (interactive)
  (let ((v (or v (read-number "Milliseconds: " (thing-at-point 'number)))))
    (message "%s = %s" v
             (format-time-string "%Y-%m-%d %H:%M:%S"
                                 (seconds-to-time (/ v 1000.0))))))
;;; mu4e
(jao-load-path "mu4e")
(use-package mu4e
  :init
  (setq mu4e-attachment-dir (expand-file-name "~/var/download/attachments")
        mu4e-change-filenames-when-moving nil
        mu4e-completing-read-function 'completing-read
        mu4e-display-update-status-in-modeline nil
        mu4e-get-mail-command "true" ;; "run-mb.sh || [ $? -eq 1 ]"
        mu4e-headers-show-threads t
        mu4e-headers-sort-direction 'ascending
        mu4e-headers-visible-columns 100
        mu4e-headers-visible-lines 12
        mu4e-hide-index-messages t
        mu4e-index-cleanup t  ;; don't do a full cleanup check
        mu4e-index-lazy-check t ;; don't consider up-to-date dirs
        mu4e-maildir "~/var/mail"
        mu4e-split-view 'horizontal ;; 'vertical
        mu4e-update-interval 300
        mu4e-use-fancy-chars nil
        mu4e-user-mail-address-list jao-mails
        mu4e-view-show-addresses t
        mu4e-view-show-images t
        mu4e-maildir-shortcuts '((:maildir "/jao/inbox" :key ?j)
                                 (:maildir "/bigml/inbox" :key ?b))
        jao-mu4e-uninteresting-mail-query
        (concat
         "flag:unread AND NOT flag:trashed"
         " AND NOT (maildir:/bigml/inbox OR maildir:/bigml/bugs OR"
         " maildir:/bigml/support OR maildir:/jao/inbox)")
        jao-mu4e-interesting-mail-query
        (concat
         "flag:unread AND NOT flag:trashed"
         " AND (maildir:/bigml/inbox OR maildir:/bigml/bugs OR"
         " maildir:/bigml/support OR maildir:/jao/inbox)")
        mu4e-bookmarks
        `((:name "Inbox" :query ,jao-mu4e-interesting-mail-query :key ?i)
          (:name "Other messages"
                 :query ,jao-mu4e-uninteresting-mail-query
                 :key 117)
          (:name "Today's messages" :query "date:today..now"
                 :key 116)
          (:name "Last 7 days" :query "date:7d..now" :hide-unread t
                 :key 119)
          (:name "Messages with PDFs"
                 :query "mime:application/pdf OR mime:x-application/pdf"
                 :key 112)))

  :config
  (defun jao-mu4e--maildir (msg)
    (when msg
      (let ((md (mu4e-message-field msg :maildir)))
        (when (string-match "/\\([^/]+\\)/.*" md)
          (match-string 1 md)))))

  (defun jao-mu4e--refile-folder (name)
    (lambda (msg)
      (let ((md (jao-mu4e--maildir msg)))
        (if (string= md name)
            (concat "/jao/" name)
          (format "/%s/%s" md name)))))

  (setq mu4e-sent-folder (jao-mu4e--refile-folder "sent"))
  (setq mu4e-drafts-folder (jao-mu4e--refile-folder "drafts"))
  (setq mu4e-trash-folder (jao-mu4e--refile-folder "trash"))
  (setq mu4e-refile-folder (jao-mu4e--refile-folder "trove"))

  (setq mu4e-contexts nil)

  (setq mu4e-view-show-images t)
  (when (fboundp 'imagemagick-register-types)
    (imagemagick-register-types))

  (define-key mu4e-view-mode-map [remap mu4e-view-verify-msg-popup]
              'epa-mail-verify)

  ;; View html message in browser (type aV)
  (add-to-list 'mu4e-view-actions
               '("ViewInBrowser" . mu4e-action-view-in-browser) t))

;;; twtxt
(use-package twtxt
  :ensure t
  :init (setq twtxt-file (expand-file-name "~/doc/jao.io/twtxt")
              twtxt-following
              '(("yarn" "https://twtxt.net/user/news/twtxt.txt"))))
;;; corfu bits
(defun jao-corfu-enable-no-auto ()
  (setq-local corfu-auto nil)
  (corfu-mode 1))

(defmacro jao-corfu-no-auto (mode)
  (let ((mode-name (intern (format "%s-mode" mode)))
        (hook-name (intern (format "%s-mode-hook" mode))))
    `(with-eval-after-load ',mode
       (add-to-list 'corfu-excluded-modes ',mode-name)
       (add-hook ',hook-name #'jao-corfu-enable-no-auto))))

(jao-corfu-no-auto eshell)

;;; gnus bits

(jao-transient-major-mode gnus-group
  ["Search"
   ("zc" "consult search" consult-notmuch)
   ("zf" "consult folder search" jao-consult-notmuch-folder)
   ("g" "gnus search" gnus-group-read-ephemeral-search-group)])

(defun jao-gnus-restart-servers ()
  (interactive)
  (message "Restarting all servers...")
  (gnus-group-enter-server-mode)
  (gnus-server-close-all-servers)
  (gnus-server-open-all-servers)
  (gnus-server-exit)
  (message "Restarting all servers... done"))

;;;; delayed expiry
(defvar jao-gnus--expire-every 50)
(defvar jao-gnus--get-count (1+ jao-gnus--expire-every))

(defun jao-gnus-get-new-news (&optional arg)
  (interactive "p")
  (when (and jao-gnus--expire-every
             (> jao-gnus--get-count jao-gnus--expire-every))
    (when jao-gnus-use-pm-imap (gnus-group-catchup "nnimap:pm/spam" t))
    (gnus-group-expire-all-groups)
    (setq jao-gnus--get-count 0))
  (setq jao-gnus--get-count (1+ jao-gnus--get-count))
  (gnus-group-get-new-news (max (if (= 1 jao-gnus--get-count) 4 3)
                                (or arg 0))))

(define-key gnus-group-mode-map "g" 'jao-gnus-get-new-news)
(define-key gnus-group-mode-map "\C-x\C-s" #'gnus-group-save-newsrc)

(defun jao-gnus--first-group ()
  (when (derived-mode-p 'gnus-group-mode)
    (gnus-group-first-unread-group)))

(with-eval-after-load "jao-afio"
  (add-hook 'jao-afio-switch-hook #'jao-gnus--first-group))

;;;; remove HTML from From contents (arxiv with r2e)
(require 'shr)
(defvar jao-gnus--from-rx
  (concat "From: \\\"?\\(  " jao-gnus--news-rx "\\)"))

(defun jao-gnus-remove-anchors ()
  (save-excursion
    (goto-char (point-min))
    (cond ((re-search-forward jao-gnus--from-rx nil t)
           (replace-match "" nil nil nil 1))
          ((re-search-forward "[gq].+ updates on arXiv.org: " nil t)
           (replace-match "")
           (let ((begin (point)))
             (when (re-search-forward "^\\(To\\|Subject\\):" nil t)
               (beginning-of-line)
               (let ((shr-width 10000))
                 (shr-render-region begin (1- (point))))))))))

(add-hook 'gnus-part-display-hook 'jao-gnus-remove-anchors)

;;;; find message id
(defun jao-gnus-file-message-id (filename)
  (with-temp-buffer
    (insert-file filename)
    (goto-char (point-min))
    (when (re-search-forward "^[Mm]essage-[Ii][Dd]: <?\\([^><]+\\)>?" nil t)
      (match-string 1))))
;;; old volume controls
(defun jao-player-volume-delta (raise)
  (jao-player-vol-delta (if raise 5 -5))
  (sit-for 0.05)
  (jao-player-show-volume))

(defun jao-player-volume-raise ()
  (interactive)
  (jao-player-volume-delta t))

(defun jao-player-volume-lower ()
  (interactive)
  (jao-player-volume-delta nil))

(defun jao-player-show-volume ()
  (interactive)
  (jao-notify "Volume" (format "%s%%" (jao-player-volume))))

;;; pdf-tools
(use-package pdf-tools
  :ensure t
  :demand t
  :init
  (add-hook 'after-init-hook
            (lambda ()
              (setq pdf-view-midnight-colors
                    (cons (frame-parameter nil 'foreground-color)
                          (frame-parameter nil 'background-color)))))

  :hook ((pdf-view-mode . jao-doc-session-mark))

  :config (pdf-tools-install)

  :diminish ((pdf-view-midnight-minor-mode . ""))

  :bind (:map pdf-view-mode-map
              (("C-c C-d" . pdf-view-midnight-minor-mode)
               ("j" . pdf-view-next-line-or-next-page)
               ("J" . pdf-view-scroll-up-or-next-page)
               ("k" . pdf-view-previous-line-or-previous-page)
               ("K" . pdf-view-scroll-down-or-previous-page))))

;;; outline mode for notmuch tree view

(defun jao-notmuch-tree--msg-prefix (msg)
  (insert (propertize (if (plist-get msg :first) "> " "  ") 'display " ")))

(defun jao-notmuch-tree--mode-setup ()
  (setq-local outline-regexp "^> \\|^En")
  (outline-minor-mode t))

(defun jao-notmuch-tree-hide-others (&optional and-show)
  (interactive)
  (outline-hide-body)
  (outline-show-entry)
  (when and-show (notmuch-tree-show-message nil)))

(defsubst jao-notmuch-tree--message-open ()
  (and (buffer-live-p notmuch-tree-message-buffer)
       (get-buffer-window notmuch-tree-message-buffer)))

(defsubst jao-notmuch--get-prop (prop &optional props)
  (or (and props (plist-get props prop))
      (notmuch-tree-get-prop prop)
      (notmuch-show-get-prop prop)))

(defun jao-notmuch--looking-at-match-p ()
  (and (jao-notmuch--get-prop :match)
       (equal (jao-notmuch--get-prop :orig-tags)
              (jao-notmuch--get-prop :tags))))

(defun jao-notmuch-tree--next (prev thread no-exit &optional ignore-new)
  (let ((line-move-ignore-invisible nil))
    (cond ((and (not ignore-new)
                (jao-notmuch--looking-at-match-p)
                (not (jao-notmuch-tree--message-open))))
          (thread
           (notmuch-tree-next-thread prev)
           (unless (or (not (notmuch-tree-get-message-properties))
                       (jao-notmuch--looking-at-match-p))
             (notmuch-tree-matching-message prev (not no-exit))))
          (t (notmuch-tree-matching-message prev (not no-exit)))))
  (when (notmuch-tree-get-message-id)
    (jao-notmuch-tree-hide-others t))
  (when prev (forward-char 2)))

(defvar jao-notmuch-tree--prefix-map
  (let ((m (make-keymap "Thread operations")))
    (define-key m (kbd "TAB") #'outline-cycle)
    (define-key m (kbd "t") #'outline-toggle-children)
    (define-key m (kbd "s") #'outline-show-entry)
    (define-key m (kbd "S") #'outline-show-all)
    (define-key m (kbd "h") #'outline-hide-entry)
    (define-key m (kbd "H") #'outline-hide-body)
    (define-key m (kbd "o") #'jao-notmuch-tree-hide-others)
    (define-key m (kbd "n") #'outline-hide-other)
    m))

(defun jao-notmuch-tree-outline-setup (&optional prefix)
  (define-key notmuch-tree-mode-map (kbd (or prefix "T"))
              jao-notmuch-tree--prefix-map)
  (define-key notmuch-tree-mode-map (kbd "TAB") #'outline-cycle)
  (define-key notmuch-tree-mode-map (kbd "M-TAB") #'outline-cycle-buffer)
  (add-hook 'notmuch-tree-mode-hook #'jao-notmuch-tree--mode-setup)
  (advice-add 'notmuch-tree-insert-msg :before #'jao-notmuch-tree--msg-prefix))

(defun jao-notmuch-tree-next (thread &optional no-exit)
  "Next message or thread in forest, taking care of thread visibility."
  (interactive "P")
  (jao-notmuch-tree--next nil thread no-exit))

(defun jao-notmuch-tree-next-thread (&optional exit)
  "Next thread in forest, taking care of thread visibility."
  (interactive "P")
  (jao-notmuch-tree--next nil t exit))

(defun jao-notmuch-tree-previous (thread)
  "Previous message or thread in forest, taking care of thread visibility."
  (interactive "P")
  (jao-notmuch-tree--next t thread t))

(defun jao-notmuch-tree-previous-thread (&optional exit)
  "Previous thread in forest, taking care of thread visibility."
  (interactive "P")
  (jao-notmuch-tree--next t t exit))


;;; snippets
(defun jao-sway-run-or-focus-tidal ()
  (interactive)
  (if (jao-shell-running-p "tidal-hifi")
      (jao-swaymsg "[app_id=tidal-hifi] scratchpad show")
    (let ((c
           "tidal-hifi --enable-features=UseOzonePlatform --ozone-platform=wayland &"))
      (start-process-shell-command "tidal-hifi" nil c))
    (jao-sway-run-or-focus-tidal)))

;;

(defun jao-afio--set-mode-line ()
  (when (and window-system (fboundp 'jao-mode-line-hide-inactive))
    (if (string= "docs" (jao-afio-frame-name))
        (jao-mode-line-show-inactive nil)
      (jao-mode-line-hide-inactive nil))))

(unless jao-modeline-in-minibuffer
  (add-hook 'jao-afio-switch-hook #'jao-afio--set-mode-line))