summaryrefslogtreecommitdiffhomepage
path: root/attic/elisp
diff options
context:
space:
mode:
Diffstat (limited to 'attic/elisp')
-rw-r--r--attic/elisp/book-mode.el760
-rw-r--r--attic/elisp/jao-ednc.el143
-rw-r--r--attic/elisp/jao-maildir.el4
-rw-r--r--attic/elisp/jao-multisession.el341
-rw-r--r--attic/elisp/jao-notmuch-gnus.el16
-rw-r--r--attic/elisp/jao-proton-utils.el141
-rw-r--r--attic/elisp/jao-spt.el148
-rw-r--r--attic/elisp/jao-vterm-repl.el130
-rw-r--r--attic/elisp/misc.el378
-rw-r--r--attic/elisp/nnnm.el16
10 files changed, 2052 insertions, 25 deletions
diff --git a/attic/elisp/book-mode.el b/attic/elisp/book-mode.el
new file mode 100644
index 0000000..eb3bfd0
--- /dev/null
+++ b/attic/elisp/book-mode.el
@@ -0,0 +1,760 @@
+;;; book-mode.el --- Book mode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Nicolas P. Rougier
+
+;; Maintainer: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
+;; URL: https://github.com/rougier/book-mode
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "27.1") (nano-theme))
+;; Keywords: convenience, mode-line, header-line
+
+;; This file is not part of GNU Emacs.
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; For a full copy of the GNU General Public License
+;; see <https://www.gnu.org/licenses/>.
+
+
+;;; Code:
+(require 'seq)
+(require 'nano-theme)
+;; (require 'nano-command)
+
+(defgroup book-mode nil
+ "Book mode"
+ :group 'convenience)
+
+(defcustom book-mode-left-margin 8
+ "Left margin size, measured in characters"
+ :type 'int
+ :group 'book-mode)
+
+(defcustom book-mode-right-margin 6
+ "Right margin size, measured in characters"
+ :type 'int
+ :group 'book-mode)
+
+(defcustom book-mode-top-margin 2.25
+ "Top margin size, measured in characters"
+ :type 'float
+ :group 'book-mode)
+
+(defcustom book-mode-top-padding 0.25
+ "Bottom margin size, measured in characters"
+ :type 'float
+ :group 'book-mode)
+
+(defcustom book-mode-bottom-margin 1.45
+ "Bottom margin size, measured in characters"
+ :type 'float
+ :group 'book-mode)
+
+(defcustom book-mode-bottom-padding 0.00
+ "Bottom margin size, measured in characters"
+ :type 'float
+ :group 'book-mode)
+
+(defcustom book-mode-frame-size '(81 . 51)
+ "Frame size"
+ :type '(cons (integer :tag "width")
+ (integer :tag "height"))
+ :group 'book-mode)
+
+(defcustom book-mode-frame-border-color nano-dark-background
+ "Frame border color"
+ :type 'color
+ :group 'book-mode)
+
+(defcustom book-mode-hl-line-extend t
+ "Whether to extend hl-line to margins"
+ :type 'boolean
+ :group 'book-mode)
+
+
+(defun book-mode--log (format-string &rest args)
+ "Log a message into the *Messages* buffer if message-log-max is
+non-nil. Return the message."
+
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (let ((inhibit-read-only t)
+ (msg (apply 'format-message format-string args)))
+ (when (and msg message-log-max)
+ (goto-char (point-max))
+ (insert (concat "\n" msg)))
+ msg)))
+
+
+(defun book-mode--message (&rest args)
+ "Message function advice that override the message function and
+saves the message in a buffer local variable."
+
+ ;; Log message
+ (when (car args)
+ (apply #'book-mode--log args))
+
+ ;; Save message in buffer local book-mode--last-message variable
+ ;; and register a timer to clear it after a delay.
+ (let* ((msg (if (and (car args) (stringp (car args)))
+ (apply 'format-message args)))
+ (msg (if (stringp msg)
+ (replace-regexp-in-string "%" "%%" msg))))
+ (setq book-mode--last-message (or msg ""))
+ (when (and (boundp 'book-mode--message-timer) book-mode--message-timer)
+ (cancel-timer book-mode--message-timer))
+ (unless isearch-mode
+ (setq book-mode--message-timer
+ ;; (run-at-time minibuffer-message-timeout nil
+ ;; #'book-mode--message-clear))
+ (run-at-time 2.0 nil #'book-mode--message-clear)))
+ (force-mode-line-update)))
+
+
+(defun book-mode--message-cancel-clear ()
+ (when (and (boundp 'book-mode--message-timer) book-mode--message-timer)
+ (cancel-timer book-mode--message-timer)))
+
+
+(defun book-mode--message-clear ()
+ "Clear last message"
+
+ (setq book-mode--last-message nil)
+ (force-mode-line-update))
+
+
+(defun book-mode--command-error-function (data context caller)
+ "This command-error function intercepts some message from the C API."
+
+ (if (not (memq (car data) '(buffer-read-only
+ text-read-only
+ beginning-of-buffer
+ end-of-buffer
+ quit)))
+ (command-error-default-function data context caller)
+ (book-mode--message (format "%s" data))))
+
+
+(defun book-mode--header (&rest args)
+ ""
+ (apply #'book-mode--build
+ (nconc `(:overline nil
+ :underline ,(face-foreground 'default)
+ :margin ,(or (plist-get args ':margin)
+ (- book-mode-top-margin))
+ :padding ,(or (plist-get args ':padding)
+ (- book-mode-top-padding)))
+ args)))
+
+
+(defun book-mode--footer (&rest args)
+ ""
+ (apply #'book-mode--build
+ (nconc `(:overline ,(face-foreground 'default)
+ :underline nil
+ :margin ,(or (plist-get args ':margin)
+ book-mode-bottom-margin)
+ :padding ,(or (plist-get args ':padding)
+ book-mode-bottom-padding))
+ args)))
+
+
+;; ----------------------------------------------------------------------------
+(defun book-mode--build (&rest args)
+ ""
+
+ (let* ((overline (or (plist-get args ':overline) nil))
+ (underline (or (plist-get args ':underline) nil))
+ (left (or (plist-get args ':left) #'book-mode-element-empty))
+ (right (or (plist-get args ':right) #'book-mode-element-empty))
+ (center (or (plist-get args ':center) #'book-mode-element-empty))
+ (prefix (or (plist-get args ':prefix) #'book-mode-element-empty))
+ (suffix (or (plist-get args ':suffix) #'book-mode-element-empty))
+ (margin (or (plist-get args ':margin) 0.0))
+ (padding (or (plist-get args ':padding) 0.0)))
+
+ `(:eval
+ (let* ((left (if (stringp (quote ,left))
+ ,left
+ (funcall (quote ,left))))
+ (right (if (stringp (quote ,right))
+ ,right
+ (funcall (quote ,right))))
+ (prefix (if (stringp (quote ,prefix))
+ ,prefix
+ (funcall (quote ,prefix))))
+ (suffix (if (stringp (quote ,suffix))
+ ,suffix
+ (funcall (quote ,suffix))))
+ (overline ,overline)
+ (underline ,underline)
+ (width (window-width))
+ (margin ,margin)
+ (padding ,padding)
+ (left-margin (or (car (window-margins)) 0))
+ (right-margin (or (cdr (window-margins)) 0))
+ (left (truncate-string-to-width left (- width (length right) 1) nil nil "…"))
+ (prefix-filler (make-string (max 0 (- left-margin (length prefix))) 32))
+ (suffix-filler (make-string (max 0 (- right-margin (length suffix))) 32)))
+
+ (add-face-text-property 0 (length left)
+ `(:underline ,underline :overline ,overline) nil left)
+ (add-face-text-property 0 (length right)
+ `(:underline ,underline :overline ,overline) nil right)
+
+ (concat
+ (propertize prefix-filler 'display `(raise ,(+ margin padding)))
+ (propertize prefix 'display `((raise ,margin)
+ ,(get-text-property 0 'display prefix)))
+ (propertize left 'display `((raise ,margin)
+ ,(get-text-property 0 'display left)))
+ (propertize " " 'display `((raise ,(+ margin))
+ (space :align-to (- right ,(length right) 0)))
+ 'face `(:box nil :underline ,underline :overline ,overline))
+ (propertize right 'display `((raise ,margin)
+ ,(get-text-property 0 'display right)))
+ (propertize suffix 'display `((raise ,margin)
+ ,(get-text-property 0 'display suffix)))
+
+ (propertize suffix-filler 'display `(raise ,(+ margin padding))))))))
+
+
+(defun book-mode-element-frame-count ()
+ (let* ((frames (seq-filter (lambda (frame)
+ (not (frame-parent frame)))
+ (frame-list)))
+ (index (length (member (selected-frame) frames))))
+ (propertize (format " %d "index)
+ 'face `(:inherit (nano-subtle nano-strong)
+ :foreground ,(face-foreground 'nano-default)))))
+
+(defun book-mode-element-frame-count-icon (&optional icon)
+ "Prefix element displaying frame count and an icon."
+
+ (concat
+ (book-mode-element-frame-count)
+ " "
+ (cond (icon
+ (propertize (format "%s " icon) 'face 'nano-default))
+ ((or (derived-mode-p 'elfeed-show-mode)
+ (derived-mode-p 'elfeed-search-mode))
+ (propertize " " 'face 'nano-default))
+ ((derived-mode-p 'org-agenda-mode)
+ (propertize " " 'face 'nano-default))
+ ((derived-mode-p 'mastodon-mode)
+ (propertize " " 'face 'nano-default))
+ ((derived-mode-p 'mu4e-headers-mode)
+ (propertize " " 'face 'nano-default))
+ ((derived-mode-p 'mu4e-view-mode)
+ (propertize " " 'face 'nano-default))
+ (view-mode
+ (propertize " " 'face 'nano-faded))
+ ((derived-mode-p 'helpful-mode)
+ (propertize " " 'face 'nano-default))
+ (buffer-read-only
+ (propertize " " 'face 'nano-faded))
+ ((buffer-modified-p)
+ (propertize " " 'face 'nano-popout))
+ (t
+ (propertize " " 'face 'nano-subtle-i)))))
+
+(defun book-mode-element-prefix-elfeed ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-agenda ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-mastodon ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-mu4e-headers ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-mu4e-view ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-helpful ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-view ()
+ (book-mode-element-frame-count-icon ""))
+
+(defun book-mode-element-prefix-generic ()
+ (book-mode-element-frame-count-icon
+ (cond (buffer-read-only
+ (propertize "" 'face 'nano-faded))
+ ((buffer-modified-p)
+ (propertize "" 'face 'nano-popout))
+ (t
+ (propertize "" 'face 'nano-subtle-i)))))
+
+(defun book-mode-element-elfeed-feed-name ()
+ (plist-get (elfeed-feed-meta
+ (elfeed-entry-feed elfeed-show-entry)) :title))
+
+(defun book-mode-element-elfeed-search-filter ()
+ elfeed-search-filter)
+
+(defun book-mode-element-agenda-name ()
+ (save-excursion
+ (goto-char (point-min))
+ (buffer-substring-no-properties (line-beginning-position))))
+
+(defun book-mode-element-mu4e-context ()
+ (if (> (length (mu4e-context-label)) 0)
+ (substring-no-properties (mu4e-context-label) 1 -1)
+ ""))
+
+(defun book-mode-element-mu4e-search-query ()
+ (mu4e-last-query))
+
+(defun book-mode-element-mu4e-message-subject ()
+ "")
+
+(defun book-mode-element-mu4e-message-sender ()
+ "")
+
+(defun book-mode-element-mu4e-message-date ()
+ "")
+
+(defun book-mode-element-buffer-name ()
+ (buffer-name))
+
+(defun book-mode-element-name ()
+
+ (let ((name (cond ;; Elfeed show mode
+ ((derived-mode-p 'elfeed-show-mode)
+ (plist-get (elfeed-feed-meta
+ (elfeed-entry-feed elfeed-show-entry)) :title))
+ ;; Elfeed show mode
+ ((derived-mode-p 'elfeed-search-mode)
+ (concat "" elfeed-search-filter))
+
+ ;; Org agenda mode
+ ((derived-mode-p 'org-agenda-mode)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ ;; (set-text-properties (line-beginning-position)
+ ;; (+ (line-end-position) 1)
+ ;; '(invisible t))
+ (buffer-substring-no-properties (line-beginning-position)
+ (- (line-end-position) 1)))))
+
+ ;; Mu4e headers mode
+ ((derived-mode-p 'mu4e-headers-mode)
+ (concat "" (mu4e-last-query)))
+ ;; Mu4e view mode
+ ((derived-mode-p 'mu4e-view-mode)
+ "Message")
+ ;; Default
+ (t (buffer-name)))))
+ (propertize name 'face '(:inherit nano-strong))))
+
+
+(defun book-mode-element-word-count ()
+
+ (let* ((beg (if (use-region-p) (region-beginning) (point-min)))
+ (end (if (use-region-p) (region-end) (point-max)))
+ (word-count (count-words beg end))
+ (char-count (- end beg)))
+ (propertize (format "%d words / %d chars" word-count char-count)
+ 'face 'nano-faded)))
+
+(defun book-mode-element-word-target ()
+
+ (let* ((word-count (count-words (point-min) (point-max)))
+ (word-total 300)
+ (ratio (/ (float word-count) (float word-total))))
+ (propertize " " 'display (svg-lib-progress-pie ratio nil))))
+
+(defun book-mode-element-dedicated ()
+ (propertize " " 'face (if (window-dedicated-p)
+ '(:inherit nano-default)
+ '(:inherit nano-subtle-i))
+ 'display '(raise 0)))
+
+(defun book-mode-element-empty ()
+ "")
+
+(defun book-mode-element-message ()
+ (if (boundp 'book-mode--last-message)
+ (or book-mode--last-message "")
+ ""))
+
+(defun book-mode-element-line/total ()
+ (propertize (format "%s/%s"(format-mode-line "%l")
+ (save-excursion
+ (goto-char (point-max))
+ (format-mode-line "%l")))))
+
+(defun book-mode-element-mu4e-query ()
+ (mu4e-last-query))
+
+(defun book-mode-element-mu4e-context ()
+ (substring-no-properties (mu4e-context-label)))
+
+(defun book-mode-element-mu4e-total ()
+ (format "%d" (plist-get mu4e--server-props :doccount)))
+
+
+;; ----------------------------------------------------------------------------
+(defun overlay-extend-to-margin (overlay &optional face left right)
+ (let* ((face (or face 'nano-popout-i))
+ (left-width (or (car (window-margins)) 0))
+ (right-width (or (cdr (window-margins)) 0))
+ (left (or left (make-string left-width ?\ )))
+ (right (or right (make-string right-width ?\ )))
+ (line-prefix (get-text-property (line-beginning-position) 'display))
+ (line-prefix (if (and (seqp line-prefix)
+ (equal (car line-prefix) '(margin left-margin)))
+ (cadr line-prefix)))
+ (left (if (stringp line-prefix) line-prefix left)))
+ (overlay-put overlay 'line-prefix
+ (concat
+ (propertize " "
+ 'display `((margin right-margin)
+ ,(propertize right 'face face)))
+ (propertize " "
+ 'display `((margin left-margin)
+ ,(propertize left 'face face)))))
+
+ (overlay-put overlay 'wrap-prefix
+ (concat
+ (propertize " "
+ 'display `((margin right-margin)
+ ,(propertize right 'face face)))
+ (propertize " "
+ 'display `((margin left-margin)
+ ,(propertize left 'face face)))))))
+
+;; (defun region-activate ()
+;; (when (boundp 'region-overlay)
+;; (overlay-extend-to-margin region-overlay 'region)
+;; (region-update)
+;; (add-hook #'post-command-hook #'region-update)))
+
+;; (defun region-deactivate ()
+;; (remove-hook #'post-command-hook #'region-update)
+;; (when (boundp 'region-overlay)
+;; (move-overlay region-overlay (point-min) (point-min))))
+
+;; (defun region-update ()
+;; (when (and (boundp 'region-overlay) (use-region-p))
+;; (move-overlay region-overlay (region-beginning) (region-end))))
+
+;; (add-hook 'activate-mark-hook #'region-activate)
+;; (add-hook 'deactivate-mark-hook #'region-deactivate)
+;; (remove-hook 'activate-mark-hook #'region-activate)
+;; (remove-hook 'deactivate-mark-hook #'region-deactivate)
+
+
+(defun book-mode-hl-line-range-function ()
+ (overlay-extend-to-margin
+ (or hl-line-overlay global-hl-line-overlay)
+ (if (derived-mode-p 'mu4e-headers-mode)
+ 'mu4e-header-highlight-face
+ 'hl-line))
+ (cons (line-beginning-position) (line-beginning-position 2)))
+
+
+;; ----------------------------------------------------------------------------
+;; (defun book-mode-old (&optional global)
+
+;; (interactive)
+;; (let ((left-margin 8)
+;; (right-margin 6)
+;; (top-margin 2.25)
+;; (top-padding 0.25)
+;; (bottom-margin 1.45)
+;; (bottom-padding 0.00))
+;; (if global
+;; (setq-default left-margin-width left-margin
+;; right-margin-width right-margin))
+;; (set-window-margins (selected-window) left-margin right-margin)
+;; (setq left-margin-width left-margin)
+;; (setq right-margin-width right-margin)
+
+;; (set-frame-parameter (selected-frame) 'internal-border-width 1)
+;; (set-frame-parameter (selected-frame) 'width (+ 81
+;; left-margin
+;; right-margin))
+;; (set-frame-parameter (selected-frame) 'height 50)
+;; (set-face-background 'internal-border nano-dark-background
+;; (selected-frame))
+
+;; (setq-local book-mode--message-timer nil)
+;; (setq-local book-mode--message-last nil)
+
+;; (setq line-spacing 1)
+;; (fringe-mode '(0 . 0))
+;; (set (make-local-variable 'region-overlay)
+;; (make-overlay (point-min) (point-min)))
+
+;; (if global
+;; (progn
+;; (set-face-attribute 'header-line nil
+;; :background (face-background 'default))
+;; (set-face-attribute 'mode-line nil
+;; :foreground (face-foreground 'default)
+;; :background (face-background 'default)
+;; :height (face-attribute 'default :height))
+;; (set-face-attribute 'mode-line-inactive nil
+;; :foreground (face-foreground 'default)
+;; :background (face-background 'default)
+;; :height (face-attribute 'default :height))
+;; (set-face-attribute 'region nil
+;; :background "#e0e0ff")
+;; (set-face-attribute 'hl-line nil
+;; :background "#f5f5ff"))
+;; (progn
+;; (face-remap-add-relative 'header-line
+;; :background (face-background 'default))
+;; (face-remap-add-relative 'mode-line
+;; :foreground (face-foreground 'default)
+;; :background (face-background 'default)
+;; :height (face-attribute 'default :height))
+;; (face-remap-add-relative 'mode-line-inactive
+;; :foreground (face-foreground 'default)
+;; :background (face-background 'default)
+;; :height (face-attribute 'default :height))
+;; (face-remap-add-relative 'region :background "#e0e0ff")
+;; (face-remap-add-relative 'hl-line :background "#f5f5ff")))
+
+;; (setq-local header-line-format
+;; (book-mode--header :prefix #'book-mode-element-prefix
+;; :left #'book-mode-element-name
+;; :suffix #'book-mode-element-dedicated
+;; :margin (- top-margin)
+;; :padding (- top-padding))
+;; mode-line-format
+;; (book-mode--footer :left #'book-mode-element-message
+;; :right #'book-mode-element-line/total
+;; :margin bottom-margin
+;; :padding bottom-padding))
+;; (when global
+;; (setq-default header-line-format header-line-format)
+;; (setq-default mode-line-format mode-line-format))
+
+;; (when (derived-mode-p 'org-mode)
+;; (add-to-list 'font-lock-extra-managed-props 'display)
+;; (let ((margin-format (format "%%%ds" left-margin)))
+;; (font-lock-add-keywords nil
+;; `(
+;; ("^\\(\\- \\)\\(.*\\)$"
+;; 1 '(face nano-default display ((margin left-margin)
+;; ,(propertize (format margin-format "• ")
+;; 'face '(:inherit nano-default :weight light)) append)))
+
+;; ("^\\(\\*\\{1\\} \\)\\(.*\\)$"
+;; 1 '(face nano-faded display ((margin left-margin)
+;; ,(propertize (format margin-format "# ")
+;; 'face '(:inherit nano-faded :weight light)) append))
+;; 2 '(face bold append))
+
+;; ("^\\(\\*\\{2\\} \\)\\(.*\\)$"
+;; 1 '(face nano-faded display ((margin left-margin)
+;; ,(propertize (format margin-format "## ")
+;; 'face '(:inherit nano-faded :weight light)) append))
+;; 2 '(face bold append))
+
+;; ("^\\(\\*\\{3\\} \\)\\(.*\\)$"
+;; 1 '(face nano-faded display ((margin left-margin)
+;; ,(propertize (format margin-format "### ")
+;; 'face '(:inherit nano-faded :weight light)) append))
+;; 2 '(face bold append))
+
+;; ("^\\*\\{4\\} .*?\\(\n\\)"
+;; 1 '(face nil display " - "))
+
+;; ("^\\(\\*\\{4\\} \\)\\(.*?\\)$"
+;; 1 '(face nano-faded display ((margin left-margin)
+;; ,(propertize (format margin-format "§ ")
+;; 'face '(:inherit nano-faded :weight light)) append))
+;; 2 '(face bold append))))))
+;; )
+
+;; (book-mode--message-clear)
+;; (advice-add 'message :override #'book-mode--message)
+;; (when (derived-mode-p 'org-mode)
+;; (font-lock-fontify-buffer)
+;; (visual-line-mode))
+;; (set (make-local-variable 'region-overlay)
+;; (make-overlay (point-min) (point-min)))
+;; (setq hl-line-range-function #'book-mode-hl-line-range-function)
+;; )
+
+
+;;;###autoload
+(defun book-mode ()
+
+ (interactive)
+ (setq linum-format
+ (format (format "%%%ds" (- book-mode-left-margin 2)) "%4d"))
+ (set-window-margins (selected-window) book-mode-left-margin
+ book-mode-right-margin)
+ (setq left-margin-width book-mode-left-margin)
+ (setq right-margin-width book-mode-right-margin)
+
+ (set-frame-parameter (selected-frame) 'internal-border-width 1)
+ (set-frame-parameter (selected-frame) 'width (+ (car book-mode-frame-size)
+ book-mode-left-margin
+ book-mode-right-margin))
+ (set-frame-parameter (selected-frame) 'height (cdr book-mode-frame-size))
+ (set-face-background 'internal-border book-mode-frame-border-color
+ (selected-frame))
+ (setq-local book-mode--message-timer nil)
+ (make-local-variable 'book-mode--message-timer)
+
+ (setq-local book-mode--message-last nil)
+ (make-local-variable 'book-mode--last-message)
+
+ (setq line-spacing 1)
+ (set-frame-parameter (selected-frame) 'right-divider-width 1)
+
+ (fringe-mode '(0 . 0))
+ (set (make-local-variable 'region-overlay)
+ (make-overlay (point-min) (point-min)))
+ (face-remap-add-relative 'header-line
+ :background (face-background 'default))
+ (face-remap-add-relative 'window-divider
+ :foreground (face-foreground 'default))
+
+ (face-remap-set-base 'mode-line nil)
+ (face-remap-set-base 'mode-line-inactive nil)
+
+ (face-remap-add-relative 'mode-line
+ :foreground (face-foreground 'default)
+ :background (face-background 'default)
+ :height (face-attribute 'default :height))
+ (face-remap-add-relative 'mode-line-inactive
+ :foreground (face-foreground 'default)
+ :background (face-background 'default)
+ :height (face-attribute 'default :height))
+ ;; (face-remap-add-relative 'region :background "#e0e0ff")
+ ;; (face-remap-add-relative 'hl-line :background "#f5f5ff")
+ (setq-local header-line-format
+ (book-mode--header :prefix #'book-mode-element-frame-count-icon
+ :left #'book-mode-element-name
+ :suffix #'book-mode-element-dedicated))
+ (setq-local mode-line-format
+ (book-mode--footer :left #'book-mode-element-message
+ :right #'book-mode-element-line/total))
+
+ (add-hook 'isearch-mode-hook
+ (lambda ()
+ (setq-local mode-line-format
+ (book-mode--footer
+ :prefix " "
+ :left #'book-mode-element-message
+ :right #'book-mode-element-line/total))
+ (book-mode--message-cancel-clear)))
+
+ (add-hook 'isearch-mode-end-hook
+ (lambda ()
+ (setq-local mode-line-format
+ (book-mode--footer
+ :left #'book-mode-element-message
+ :right #'book-mode-element-line/total))
+ (book-mode--message-clear)))
+
+ (book-mode--message-clear)
+ (advice-add 'message :override #'book-mode--message)
+ (set (make-local-variable 'region-overlay)
+ (make-overlay (point-min) (point-min)))
+ (setq hl-line-range-function #'book-mode-hl-line-range-function))
+
+(defun my/hide-cursor ()
+ (setq cursor-type nil))
+
+(defun my/hide-org-agenda-header-line ()
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (set-text-properties (line-beginning-position)
+ (+ (line-end-position) 1)
+ '(invisible t)))))
+
+(add-hook 'elfeed-search-mode-hook 'book-mode)
+(add-hook 'elfeed-show-mode-hook 'book-mode)
+(add-hook 'org-agenda-mode-hook 'book-mode)
+(add-hook 'org-agenda-finalize-hook 'my/hide-org-agenda-header-line)
+(add-hook 'mu4e-headers-mode-hook 'book-mode)
+(add-hook 'mu4e-headers-mode-hook 'my/hide-cursor)
+(add-hook 'mu4e-loading-mode-hook 'book-mode)
+(add-hook 'mu4e-view-mode-hook 'book-mode)
+(add-hook 'mu4e-compose-mode-hook 'book-mode)
+(add-hook 'help-mode-hook 'book-mode)
+(add-hook 'helpful-mode-hook 'book-mode)
+(add-hook 'mastodon-mode-hook 'book-mode)
+(add-hook 'python-mode-hook 'book-mode)
+(add-hook 'emacs-lisp-mode-hook 'book-mode)
+
+(provide 'book-mode)
+;;; book-mode.el ends here
+
+
+;; (defun book-command--update (prompt text)
+;; (let* ((prompt (string-trim (substring-no-properties prompt)))
+;; (prompt (propertize prompt 'face 'nano-strong )))
+;; (setq-local book-mode--last-message
+;; (concat prompt " " text))))
+
+;; (defun book-command (prompt &optional hook icon)
+;; (advice-add 'nano-command--update :override #'book-command--update)
+;; (setq-local mode-line-format
+;; (book-mode--footer :prefix (or icon "")
+;; :left #'book-mode-element-message
+;; :right #'book-mode-element-line/total
+;; :margin 0.0
+;; :padding 0.0))
+;; (let ((command (nano-command prompt hook
+;; (propertize "\n" 'face '(:height 1.2)))))
+;; (setq-local mode-line-format
+;; (book-mode--footer :left #'book-mode-element-message
+;; :right #'book-mode-element-line/total))
+;; (advice-remove 'nano-command--update #'book-command--update)
+;; (setq-local book-mode--last-message "")
+;; (force-mode-line-update)
+;; command))
+
+;; (bind-key "H-&" #'(lambda ()
+;; (interactive)
+;; (let ((command (book-command "SHELL:" nil " ")))
+;; (when command
+;; (async-shell-command command)))))
+
+
+;; (defun org-quick-meeting-hook ()
+;; (insert (format-time-string (concat " "
+;; (cdr org-time-stamp-formats))))
+;; (goto-char (point-min))
+;; (org-mode))
+
+;; (defun org-quick-meeting-refile (file headline)
+;; (let ((pos (save-excursion
+;; (find-file file)
+;; (org-find-exact-headline-in-buffer headline))))
+;; (org-refile nil nil (list headline file nil pos))))
+
+;; (defun org-quick-meeting ()
+;; "This function allows to register a meeting (org)"
+
+;; (interactive)
+;; (let ((capture (book-command "MEETING " #'org-quick-meeting-hook " ")))
+;; (when capture
+;; (let ((current-buffer (current-buffer)))
+;; (with-temp-buffer
+;; (insert (format "** %s\n" capture))
+;; (goto-char (point-min))
+;; (org-quick-meeting-refile "~/Documents/org/agenda.org" "Future"))
+;; (switch-to-buffer current-buffer)))))
+
+;; (bind-key "H-m" #'org-quick-meeting)
diff --git a/attic/elisp/jao-ednc.el b/attic/elisp/jao-ednc.el
new file mode 100644
index 0000000..92ee21f
--- /dev/null
+++ b/attic/elisp/jao-ednc.el
@@ -0,0 +1,143 @@
+;;; jao-ednc.el --- Minibuffer notifications using EDNC -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020, 2021, 2024 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: tools, abbrev
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Use the ednc package to provide a notification daemon that uses
+;; the minibuffer to display them.
+
+;;; Code:
+
+(require 'ednc)
+(require 'jao-minibuffer)
+
+(declare-function tracking-add-buffer "tracking")
+(declare-function tracking-remove-buffer "tracking")
+
+(defvar jao-ednc--count-format " {%d} ")
+(defvar jao-ednc--notifications ())
+(defvar jao-ednc--handlers ())
+
+(defvar jao-ednc-use-tracking nil)
+
+(defface jao-ednc-tracking '((t :inherit warning))
+ "Tracking notifications face"
+ :group 'jao-ednc)
+
+(defun jao-ednc--last-notification () (car jao-ednc--notifications))
+
+(defun jao-ednc--format-last ()
+ (when (jao-ednc--last-notification)
+ (let ((s (ednc-format-notification (jao-ednc--last-notification) t)))
+ (replace-regexp-in-string "\n" " " (substring-no-properties s)))))
+
+(defun jao-ednc--count ()
+ (let ((no (length jao-ednc--notifications)))
+ (if (> no 0)
+ (propertize (format jao-ednc--count-format no) 'face 'warning)
+ "")))
+
+(defun jao-ednc-add-handler (app handler)
+ (add-to-list 'jao-ednc--handlers (cons app handler)))
+
+(defun jao-ednc-ignore-app (app)
+ (jao-ednc-add-handler app
+ (lambda (not _)
+ (ignore-errors (ednc-dismiss-notification not)))))
+
+(defun jao-ednc--clean (&optional notification)
+ (tracking-remove-buffer (get-buffer ednc-log-name))
+ (if notification
+ (remove notification jao-ednc--notifications)
+ (pop jao-ednc--notifications))
+ (jao-minibuffer-refresh))
+
+(defun jao-ednc--show-last ()
+ (message (jao-ednc--format-last)))
+
+(defun jao-ednc--default-handler (notification newp)
+ (if (not newp)
+ (jao-ednc--clean notification)
+ (when jao-ednc-use-tracking
+ (tracking-add-buffer (get-buffer ednc-log-name) '(jao-ednc-tracking)))
+ (push notification jao-ednc--notifications)
+ (jao-ednc--show-last)))
+
+(defun jao-ednc--handler (notification)
+ (alist-get (ednc-notification-app-name notification)
+ jao-ednc--handlers
+ #'jao-ednc--default-handler
+ nil
+ 'string=))
+
+(defun jao-ednc--on-notify (old new)
+ (when old (funcall (jao-ednc--handler old) old nil))
+ (when new (funcall (jao-ednc--handler new) new t)))
+
+(defun jao-ednc-setup (minibuffer-order)
+ (setq jao-notify-use-messages t)
+ (with-eval-after-load "tracking"
+ (when jao-ednc-use-tracking
+ (add-to-list 'tracking-faces-priorities 'jao-ednc-tracking)
+ (when (listp tracking-shorten-modes)
+ (add-to-list 'tracking-shorten-modes 'ednc-view-mode))))
+ (when minibuffer-order
+ (jao-minibuffer-add-variable '(jao-ednc--count) minibuffer-order))
+ (add-hook 'ednc-notification-presentation-functions #'jao-ednc--on-notify)
+ (ednc-mode))
+
+(defun jao-ednc-pop ()
+ (interactive)
+ (pop-to-buffer-same-window ednc-log-name))
+
+(defun jao-ednc-show ()
+ (interactive)
+ (if (not (jao-ednc--last-notification))
+ (jao-ednc-pop)
+ (jao-ednc--show-last)))
+
+(defun jao-ednc-invoke-last-action ()
+ (interactive)
+ (if (jao-ednc--last-notification)
+ (ednc-invoke-action (jao-ednc--last-notification))
+ (message "No active notifications"))
+ (jao-ednc--clean))
+
+(defun jao-ednc-dismiss ()
+ (interactive)
+ (when (jao-ednc--last-notification)
+ (ignore-errors
+ (with-current-buffer ednc-log-name
+ (ednc-dismiss-notification (jao-ednc--last-notification)))))
+ (jao-ednc--clean))
+
+(defun jao-ednc-dismiss-and-show ()
+ (interactive)
+ (let ((m (jao-ednc--format-last)))
+ (jao-ednc-dismiss)
+ (when m (message m))))
+
+(defun jao-ednc-dismiss-all ()
+ (interactive)
+ (while (jao-ednc--last-notification)
+ (jao-ednc-dismiss)))
+
+(provide 'jao-ednc)
+;;; jao-ednc.el ends here
diff --git a/attic/elisp/jao-maildir.el b/attic/elisp/jao-maildir.el
index 18a1725..3078a95 100644
--- a/attic/elisp/jao-maildir.el
+++ b/attic/elisp/jao-maildir.el
@@ -90,8 +90,8 @@
0))
(defun jao-maildir--update-track-string (mbox)
- (when-let ((track (seq-find (lambda (td) (string-match-p (car td) mbox))
- jao-maildir--trackers)))
+ (when-let* ((track (seq-find (lambda (td) (string-match-p (car td) mbox))
+ jao-maildir--trackers)))
(let* ((label (cadr track))
(other (assoc-delete-all label jao-maildir--track-strings))
(cnt (jao-maildir--tracked-count track)))
diff --git a/attic/elisp/jao-multisession.el b/attic/elisp/jao-multisession.el
new file mode 100644
index 0000000..7c06183
--- /dev/null
+++ b/attic/elisp/jao-multisession.el
@@ -0,0 +1,341 @@
+;;; multisession.el --- Multisession storage for variables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides multisession variables for Emacs Lisp, to
+;; make them persist between sessions.
+;;
+;; Use `define-multisession-variable' to define a multisession
+;; variable, and `multisession-value' to read its value. Use
+;; `list-multisession-values' to list multisession variables.
+;;
+;; Users might want to customize `multisession-storage' and
+;; `multisession-directory'.
+;;
+;; See Info node `(elisp) Multisession Variables' for more
+;; information.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'tabulated-list)
+
+(defcustom multisession-storage 'files
+ "Storage method for multisession variables.
+Valid methods are `sqlite' and `files'."
+ :type '(choice (const :tag "SQLite" sqlite)
+ (const :tag "Files" files))
+ :version "29.1"
+ :group 'files)
+
+(defcustom multisession-directory (expand-file-name "multisession/"
+ user-emacs-directory)
+ "Directory to store multisession variables."
+ :type 'file
+ :version "29.1"
+ :group 'files)
+
+;;;###autoload
+(defmacro define-multisession-variable (name initial-value &optional doc
+ &rest args)
+ "Make NAME into a multisession variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-multisession'."
+ (declare (indent defun))
+ (unless (plist-get args :package)
+ (setq args (nconc (list :package
+ (replace-regexp-in-string "-.*" ""
+ (symbol-name name)))
+ args)))
+ `(defvar ,name
+ (make-multisession :key ,(symbol-name name)
+ :initial-value ,initial-value
+ ,@args)
+ ,@(list doc)))
+
+(defconst multisession--unbound (make-symbol "unbound"))
+
+(cl-defstruct (multisession
+ (:constructor nil)
+ (:constructor multisession--create)
+ (:conc-name multisession--))
+ "A persistent variable that will live across Emacs invocations."
+ key
+ (initial-value nil)
+ package
+ (storage multisession-storage)
+ (synchronized nil)
+ (cached-value multisession--unbound)
+ (cached-sequence 0))
+
+(cl-defun make-multisession (&key key initial-value package synchronized
+ storage)
+ "Create a multisession object."
+ (unless package
+ (error "No package for the multisession object"))
+ (unless key
+ (error "No key for the multisession object"))
+ (unless (stringp package)
+ (error "The package has to be a string"))
+ (unless (stringp key)
+ (error "The key has to be a string"))
+ (multisession--create
+ :key key
+ :synchronized synchronized
+ :initial-value initial-value
+ :package package
+ :storage (or storage multisession-storage)))
+
+(defun multisession-value (object)
+ "Return the value of the multisession OBJECT."
+ (if (null user-init-file)
+ ;; If we don't have storage, then just return the value from the
+ ;; object.
+ (if (eq (multisession--cached-value object) multisession--unbound)
+ (multisession--initial-value object)
+ (multisession--cached-value object))
+ ;; We have storage, so we update from storage.
+ (multisession-backend-value (multisession--storage object) object)))
+
+(defun multisession--set-value (object value)
+ "Set the stored value of OBJECT to VALUE."
+ (if (null user-init-file)
+ ;; We have no backend, so just store the value.
+ (setf (multisession--cached-value object) value)
+ ;; We have a backend.
+ (multisession--backend-set-value (multisession--storage object)
+ object value)))
+
+(defun multisession-delete (object)
+ "Delete OBJECT from the backend storage."
+ (multisession--backend-delete (multisession--storage object) object))
+
+(gv-define-simple-setter multisession-value multisession--set-value)
+
+;; Files Backend
+
+(defun multisession--encode-file-name (name)
+ (url-hexify-string name))
+
+(defun multisession--read-file-value (file object)
+ (catch 'done
+ (let ((i 0)
+ last-error)
+ (while (< i 10)
+ (condition-case err
+ (throw 'done
+ (with-temp-buffer
+ (let* ((time (file-attribute-modification-time
+ (file-attributes file)))
+ (coding-system-for-read 'utf-8-emacs-unix))
+ (insert-file-contents file)
+ (let ((stored (read (current-buffer))))
+ (setf (multisession--cached-value object) stored
+ (multisession--cached-sequence object) time)
+ stored))))
+ ;; Windows uses OS-level file locking that may preclude
+ ;; reading the file in some circumstances. In addition,
+ ;; rename-file is not an atomic operation on MS-Windows,
+ ;; when the target file already exists, so there could be a
+ ;; small race window when the file to read doesn't yet
+ ;; exist. So when these problems happen, wait a bit and retry.
+ ((permission-denied file-missing)
+ (setq i (1+ i)
+ last-error err)
+ (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+ (signal (car last-error) (cdr last-error)))))
+
+(defun multisession--object-file-name (object)
+ (expand-file-name
+ (concat "files/"
+ (multisession--encode-file-name (multisession--package object))
+ "/"
+ (multisession--encode-file-name (multisession--key object))
+ ".value")
+ multisession-directory))
+
+(cl-defmethod multisession-backend-value ((_type (eql 'files)) object)
+ (let ((file (multisession--object-file-name object)))
+ (cond
+ ;; We have no value yet; see whether it's stored.
+ ((eq (multisession--cached-value object) multisession--unbound)
+ (if (file-exists-p file)
+ (multisession--read-file-value file object)
+ ;; Nope; return the initial value.
+ (multisession--initial-value object)))
+ ;; We have a value, but we want to update in case some other
+ ;; Emacs instance has updated.
+ ((multisession--synchronized object)
+ (if (and (file-exists-p file)
+ (time-less-p (multisession--cached-sequence object)
+ (file-attribute-modification-time
+ (file-attributes file))))
+ (multisession--read-file-value file object)
+ ;; Nothing, return the cached value.
+ (multisession--cached-value object)))
+ ;; Just return the cached value.
+ (t
+ (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql 'files))
+ object value)
+ (let ((file (multisession--object-file-name object))
+ (time (current-time)))
+ ;; Ensure that the directory exists.
+ (let ((dir (file-name-directory file)))
+ (unless (file-exists-p dir)
+ (make-directory dir t)))
+ (with-temp-buffer
+ (let ((print-length nil)
+ (print-circle t)
+ (print-level nil))
+ (prin1 value (current-buffer)))
+ (goto-char (point-min))
+ (condition-case nil
+ (read (current-buffer))
+ (error (error "Unable to store unreadable value: %s" (buffer-string))))
+ ;; Write to a temp file in the same directory and rename to the
+ ;; file for somewhat better atomicity.
+ (let ((coding-system-for-write 'utf-8-emacs-unix)
+ (create-lockfiles nil)
+ (temp (make-temp-name file))
+ (write-region-inhibit-fsync nil))
+ (write-region (point-min) (point-max) temp nil 'silent)
+ (set-file-times temp time)
+ (rename-file temp file t)))
+ (setf (multisession--cached-sequence object) time
+ (multisession--cached-value object) value)))
+
+(cl-defmethod multisession--backend-values ((_type (eql 'files)))
+ (mapcar (lambda (file)
+ (let ((bits (file-name-split file)))
+ (list (url-unhex-string (car (last bits 2)))
+ (url-unhex-string
+ (file-name-sans-extension (car (last bits))))
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8-emacs-unix))
+ (insert-file-contents file)
+ (read (current-buffer)))))))
+ (directory-files-recursively
+ (expand-file-name "files" multisession-directory)
+ "\\.value\\'")))
+
+(cl-defmethod multisession--backend-delete ((_type (eql 'files)) object)
+ (let ((file (multisession--object-file-name object)))
+ (when (file-exists-p file)
+ (delete-file file))))
+
+;; Mode for editing.
+
+(defvar-keymap multisession-edit-mode-map
+ :parent tabulated-list-mode-map
+ "d" #'multisession-delete-value
+ "e" #'multisession-edit-value)
+
+(define-derived-mode multisession-edit-mode special-mode "Multisession"
+ "This mode lists all elements in the \"multisession\" database."
+ :interactive nil
+ (buffer-disable-undo)
+ (setq-local buffer-read-only t
+ truncate-lines t)
+ (setq tabulated-list-format
+ [("Package" 10)
+ ("Key" 30)
+ ("Value" 30)])
+ (setq-local revert-buffer-function #'multisession-edit-mode--revert))
+
+;;;###autoload
+(defun list-multisession-values (&optional choose-storage)
+ "List all values in the \"multisession\" database.
+If CHOOSE-STORAGE (interactively, the prefix), query for the
+storage method to list."
+ (interactive "P")
+ (let ((storage
+ (if choose-storage
+ (intern (completing-read "Storage method: " '(sqlite files) nil t))
+ multisession-storage)))
+ (pop-to-buffer (get-buffer-create (format "*Multisession %s*" storage)))
+ (multisession-edit-mode)
+ (setq-local multisession-storage storage)
+ (multisession-edit-mode--revert)
+ (goto-char (point-min))))
+
+(defun multisession-edit-mode--revert (&rest _)
+ (let ((inhibit-read-only t)
+ (id (get-text-property (point) 'tabulated-list-id)))
+ (erase-buffer)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar (lambda (elem)
+ (list
+ (cons (car elem) (cadr elem))
+ (vector (car elem) (cadr elem)
+ (string-replace "\n" "\\n"
+ (format "%s" (caddr elem))))))
+ (multisession--backend-values multisession-storage)))
+ (tabulated-list-print t)
+ (goto-char (point-min))
+ (when id
+ (when-let* ((match
+ (text-property-search-forward 'tabulated-list-id id t)))
+ (goto-char (prop-match-beginning match))))))
+
+(defun multisession-delete-value (id)
+ "Delete the value at point."
+ (interactive (list (get-text-property (point) 'tabulated-list-id))
+ multisession-edit-mode)
+ (unless id
+ (error "No value on the current line"))
+ (unless (yes-or-no-p "Really delete this item? ")
+ (user-error "Not deleting"))
+ (multisession--backend-delete multisession-storage
+ (make-multisession :package (car id)
+ :key (cdr id)))
+ (let ((inhibit-read-only t))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+
+(defun multisession-edit-value (id)
+ "Edit the value at point."
+ (interactive (list (get-text-property (point) 'tabulated-list-id))
+ multisession-edit-mode)
+ (unless id
+ (error "No value on the current line"))
+ (let* ((object (or
+ ;; If the multisession variable already exists, use
+ ;; it (so that we update it).
+ (if-let* ((sym (intern-soft (cdr id))))
+ (and (boundp sym) (symbol-value sym))
+ nil)
+ ;; Create a new object.
+ (make-multisession
+ :package (car id)
+ :key (cdr id)
+ :storage multisession-storage)))
+ (value (multisession-value object)))
+ (setf (multisession-value object)
+ (car (read-from-string
+ (read-string "New value: " (prin1-to-string value))))))
+ (multisession-edit-mode--revert))
+
+(provide 'jao-multisession)
+
+;;; multisession.el ends here
diff --git a/attic/elisp/jao-notmuch-gnus.el b/attic/elisp/jao-notmuch-gnus.el
index 1576964..20defba 100644
--- a/attic/elisp/jao-notmuch-gnus.el
+++ b/attic/elisp/jao-notmuch-gnus.el
@@ -62,7 +62,7 @@
(defun jao-notmuch-gnus-show-tags ()
"Display in the echo area the tags of the current message."
(interactive)
- (when-let (id (jao-notmuch-gnus-message-id))
+ (when-let* ((id (jao-notmuch-gnus-message-id)))
(message "%s" (string-join (jao-notmuch-gnus-message-tags id) " "))))
(defun jao-notmuch-gnus-toggle-tags (tags &optional id current)
@@ -77,7 +77,7 @@
(defun jao-notmuch-gnus-tag-mark ()
"Remove the new tag for an article when it's marked as seen by Gnus."
- (when-let (id (jao-notmuch-gnus-message-id t))
+ (when-let* ((id (jao-notmuch-gnus-message-id t)))
(jao-notmuch-gnus-tag-message id '("-new") t)))
(add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark)
@@ -189,12 +189,12 @@ Example:
(org-gnus-follow-link group id)))
(defun jao-notmuch-gnus-org-store ()
- (when-let (d (or (when (derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode)
- (cons (notmuch-show-get-message-id)
- (notmuch-show-get-subject)))
- (when (derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
- (cons (jao-notmuch-gnus-message-id)
- (gnus-summary-article-subject)))))
+ (when-let* ((d (or (when (derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode)
+ (cons (notmuch-show-get-message-id)
+ (notmuch-show-get-subject)))
+ (when (derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
+ (cons (jao-notmuch-gnus-message-id)
+ (gnus-summary-article-subject))))))
(org-link-store-props :type "mail"
:link (concat "mail:" (car d))
:description (concat "Mail: " (cdr d)))))
diff --git a/attic/elisp/jao-proton-utils.el b/attic/elisp/jao-proton-utils.el
new file mode 100644
index 0000000..a8f13eb
--- /dev/null
+++ b/attic/elisp/jao-proton-utils.el
@@ -0,0 +1,141 @@
+;; jao-proton-utils.el -- simple interaction with Proton mail and vpn -*- lexical-binding: t; -*-
+
+;; Copyright (c) 2018, 2019, 2020, 2023, 2026 Jose Antonio Ortega Ruiz
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
+;; Start date: Fri Dec 21, 2018 23:56
+
+;;; Comentary:
+
+;; This is a very simple comint-derived mode to run the CLI version
+;; of PM's Bridge within the comfort of emacs.
+
+;;; Code:
+
+(define-derived-mode proton-bridge-mode comint-mode "proton-bridge"
+ "A very simple comint-based mode to run ProtonMail's bridge"
+ (setq comint-prompt-read-only t)
+ (setq comint-prompt-regexp "^>>> "))
+
+;;;###autoload
+(defun run-proton-bridge ()
+ "Run or switch to an existing bridge process, using its CLI"
+ (interactive)
+ (pop-to-buffer (make-comint "proton-bridge" "protonmail-bridge" nil "-c"))
+ (unless (eq major-mode 'proton-bridge-mode)
+ (proton-bridge-mode)))
+
+;;;###autoload
+(defun proton-bridge-sendmail-setup ()
+ "Configure message sending for local proton bridge."
+ (setq send-mail-function #'smtpmail-send-it)
+ (setq message-send-mail-function #'smtpmail-send-it)
+ (setq smtpmail-servers-requiring-authorization
+ (regexp-opt '("localhost" "127.0.0.1")))
+ (setq smtpmail-auth-supported '(plain login))
+ (setq smtpmail-smtp-user "mail@jao.io")
+ (setq smtpmail-smtp-server "localhost")
+ (setq smtpmail-smtp-service 1025))
+
+(defvar jao-proton-vpn-font-lock-keywords '("\\[.+\\]"))
+
+(defvar proton-vpn-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map [?q] 'bury-buffer)
+ (define-key map [?n] 'next-line)
+ (define-key map [?p] 'previous-line)
+ (define-key map [?g] 'proton-vpn-status)
+ (define-key map [?r] 'proton-vpn-reconnect)
+ (define-key map [?d] (lambda ()
+ (interactive)
+ (when (y-or-n-p "Disconnect?")
+ (proton-vpn-disconnect))))
+ (define-key map [?c] 'proton-vpn-connect)
+ map))
+
+
+;;;###autoload
+(defun proton-vpn-mode ()
+ "A very simple mode to show the output of ProtonVPN commands"
+ (interactive)
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map proton-vpn-mode-map)
+ (setq-local font-lock-defaults '(jao-proton-vpn-font-lock-keywords))
+ (setq-local truncate-lines t)
+ (setq-local next-line-add-newlines nil)
+ (setq major-mode 'proton-vpn-mode)
+ (setq mode-name "proton-vpn")
+ (read-only-mode 1))
+
+(defvar jao-proton-vpn--buffer "*pvpn*")
+
+(defun jao-proton-vpn--do (things)
+ (let ((b (pop-to-buffer (get-buffer-create jao-proton-vpn--buffer))))
+ (let ((inhibit-read-only t)
+ (cmd (format "protonvpn-cli %s" things)))
+ (delete-region (point-min) (point-max))
+ (message "Running: %s ...." cmd)
+ (shell-command cmd b)
+ (message ""))
+ (proton-vpn-mode)))
+
+;;;###autoload
+(defun proton-vpn-status ()
+ (interactive)
+ (jao-proton-vpn--do "s"))
+
+(defun proton-vpn--get-status ()
+ (or (when-let* ((b (get-buffer jao-proton-vpn--buffer)))
+ (with-current-buffer b
+ (goto-char (point-min))
+ (if (re-search-forward "^Status: *\\(.+\\)$" nil t)
+ (match-string-no-properties 1)
+ (when (re-search-forward "^Connected!$")
+ "Connected"))))
+ "Disconnected"))
+
+;;;###autoload
+(defun proton-vpn-connect (cc)
+ (interactive "P")
+ (let ((cc (when cc (read-string "Country code: "))))
+ (jao-proton-vpn--do (if cc (format "c --cc %s" cc) "c --sc"))
+ (proton-vpn-status)))
+
+(defun proton-vpn-reconnect ()
+ (interactive)
+ (jao-proton-vpn--do "r"))
+
+(setenv "PVPN_WAIT" "300")
+
+;;;###autoload
+(defun proton-vpn-maybe-reconnect ()
+ (interactive)
+ (when (string= "Connected" (proton-vpn--get-status))
+ (jao-proton-vpn--do "d")
+ (sit-for 5)
+ (jao-proton-vpn--do "r")))
+
+;;;###autoload
+(defun proton-vpn-disconnect ()
+ (interactive)
+ (jao-proton-vpn--do "d"))
+
+(provide 'jao-proton-utils)
+;;; jao-proton.el ends here
diff --git a/attic/elisp/jao-spt.el b/attic/elisp/jao-spt.el
new file mode 100644
index 0000000..ba5d104
--- /dev/null
+++ b/attic/elisp/jao-spt.el
@@ -0,0 +1,148 @@
+;;; jao-spt.el --- Access to the spotify-tui CLI -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021, 2022, 2024 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: multimedia
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Simple spotifyd controls via the spt executable.
+
+;;; Code:
+
+(require 'jao-minibuffer)
+(require 'jao-notify)
+
+(defvar jao-spt-bin "spt")
+(defvar jao-spt-format "'%s %t - %a [%r] %f'")
+(defvar jao-spt-device nil)
+
+(defun jao-spt--exec-async (&rest args)
+ (let ((display-buffer-alist `((".*spt commands.*" display-buffer-no-window)))
+ (buff (get-buffer-create "* spt commands *")))
+ (apply #'start-process "spt" buff jao-spt-bin args)))
+
+(defvar jao-spt--status-str "")
+
+(defun jao-spt--pb (&rest args)
+ (let* ((args (mapconcat #'identity args " "))
+ (dev (if jao-spt-device (format "-d '%s'" jao-spt-device) ""))
+ (cmd (format "%s pb %s -f %s %s" jao-spt-bin args jao-spt-format dev))
+ (st (string-trim (shell-command-to-string cmd))))
+ (setq jao-spt--status-str (when (string-prefix-p "▶" st) st))
+ (jao-minibuffer-refresh)
+ st))
+
+(defun jao-spt--pb* (&rest args)
+ (message "%s" (apply 'jao-spt--pb args)))
+
+;;;###autoload
+(defun jao-spt-play-uri (uri)
+ (jao-spt--exec-async "play" "--uri" uri))
+
+;;;###autoload
+(defun jao-spt-update-status ()
+ (interactive)
+ (jao-spt--pb))
+
+;;;###autoload
+(defun jao-spt-toggle ()
+ (interactive)
+ (jao-spt--pb* "-t"))
+
+;;;###autoload
+(defun jao-spt-next ()
+ (interactive)
+ (jao-spt--pb* "-n"))
+
+;;;###autoload
+(defun jao-spt-previous ()
+ (interactive)
+ (jao-spt--pb* "-p"))
+
+;;;###autoload
+(defun jao-spt-like ()
+ (interactive)
+ (jao-spt--pb* "--like"))
+
+;;;###autoload
+(defun jao-spt-dislike ()
+ (interactive)
+ (jao-spt--pb* "--dislike"))
+
+;;;###autoload
+(defun jao-spt-toggle-shuffle ()
+ (interactive)
+ (jao-spt--pb* "--shuffle"))
+
+;;;###autoload
+(defun jao-spt-seek (&optional secs)
+ (interactive "p")
+ (let ((secs (if (zerop (or secs 0)) 10 secs)))
+ (jao-spt--pb* "--seek" (format "%d" secs))))
+
+;;;###autoload
+(defun jao-spt-seek-back (&optional secs)
+ (interactive "p")
+ (jao-spt-seek (- secs)))
+
+(defun jao-spt--get-vol (delta)
+ (let* ((jao-spt-format "%v")
+ (v (string-to-number (jao-spt--pb))))
+ (number-to-string (max 0 (+ delta v)))))
+
+;;;###autoload
+(defun jao-spt-vol (&optional n)
+ (interactive "p")
+ (let ((n (or n 10)))
+ (jao-spt--pb* "--volume" (jao-spt--get-vol (if (zerop n) 10 n)))))
+
+;;;###autoload
+(defun jao-spt-vol-down (&optional n)
+ (interactive "p")
+ (jao-spt-vol (- (or n 10))))
+
+;;;###autoload
+(defun jao-spt-echo-current ()
+ (interactive)
+ (let ((jao-notify-use-messages t))
+ (jao-notify (jao-spt-update-status))))
+
+;;;###autoload
+(defun jao-spt-toggle-shuffle ()
+ (interactive)
+ (jao-spt--pb* "--shuffle"))
+
+;;;###autoload
+(defun jao-spt-set-up ()
+ (jao-minibuffer-add-msg-variable 'jao-spt--status-str))
+
+(defun jao-spt-lyrics-info ()
+ (let* ((jao-spt-format "%a~~~%t")
+ (s (jao-spt--pb))
+ (at (split-string s "~~~")))
+ (cons (car at) (cadr at))))
+
+(declare jao-show-lyrics "jao-lyrics")
+
+;;;###autoload
+(defun jao-spt-show-lyrics (force)
+ (interactive "P")
+ (jao-show-lyrics force #'jao-spt-lyrics-info))
+
+(provide 'jao-spt)
+;;; jao-spt.el ends here
diff --git a/attic/elisp/jao-vterm-repl.el b/attic/elisp/jao-vterm-repl.el
new file mode 100644
index 0000000..699ff39
--- /dev/null
+++ b/attic/elisp/jao-vterm-repl.el
@@ -0,0 +1,130 @@
+;;; jao-vterm-repl.el --- vterm-based repls -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020, 2021 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: terminals
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Helpers to launch reply things such as erlang shells inside a vterm.
+;; For instance, to declare an erl repl for rebar projects, one would call:
+;;
+;; (jao-vterm-repl-register "rebar.config" "rebar3 shell" "^[0-9]+> ")
+
+;;; Code:
+
+(require 'jao-compilation)
+
+(declare-function 'vterm-copy-mode "vterm")
+(declare-function 'vterm-send-string "vterm")
+(declare-function 'vterm-send-return "vterm")
+
+(defun jao-vterm-repl--buffer-name (&optional dir)
+ (format "*vterm -- repl - %s*" (or dir (jao-compilation-root))))
+
+(defvar jao-vterm-repl-repls nil)
+(defvar jao-vterm-repl-prompts nil)
+(defvar-local jao-vterm-repl--name nil)
+(defvar-local jao-vterm-repl--last-buffer nil)
+(defvar-local jao-vterm-repl--prompt-rx "^[0-9]+> ")
+
+(setq vterm-buffer-name-string nil)
+
+(defun jao-vterm-repl--exec (cmd &optional name)
+ (vterm name)
+ (when name
+ (vterm-send-string "unset PROMPT_COMMAND\n\n"))
+ (vterm-send-string cmd)
+ (vterm-send-return)
+ (when name (rename-buffer name t)))
+
+;;;###autoload
+(defun jao-vterm-repl-previous-prompt ()
+ (interactive)
+ (when (derived-mode-p 'vterm-mode)
+ (vterm-copy-mode 1)
+ (forward-line 0)
+ (when (re-search-backward jao-vterm-repl--prompt-rx nil t)
+ (goto-char (match-end 0)))))
+
+;;;###autoload
+(defun jao-vterm-repl-next-prompt ()
+ (interactive)
+ (when (derived-mode-p 'vterm-mode)
+ (vterm-copy-mode 1)
+ (or (re-search-forward jao-vterm-repl--prompt-rx nil t)
+ (vterm-copy-mode -1))
+ (unless (save-excursion
+ (re-search-forward jao-vterm-repl--prompt-rx nil t))
+ (vterm-copy-mode -1))))
+
+;;;###autoload
+(define-minor-mode jao-vterm-repl-mode "repl-aware vterm" nil nil
+ '(("\C-c\C-p" . jao-vterm-repl-previous-prompt)
+ ("\C-c\C-n" . jao-vterm-repl-next-prompt)
+ ("\C-c\C-z" . jao-vterm-repl-pop-to-src)))
+
+;;;###autoload
+(defun jao-vterm-repl ()
+ (let* ((dir (jao-compilation-root))
+ (vname (jao-vterm-repl--buffer-name dir))
+ (root-name (jao-compilation-root-file))
+ (buffer (seq-find `(lambda (b)
+ (string=
+ (buffer-local-value 'jao-vterm-repl--name
+ b)
+ ,vname))
+ (buffer-list))))
+ (or buffer
+ (let ((default-directory dir)
+ (prompt (cdr (assoc root-name jao-vterm-repl-prompts)))
+ (cmd (or (cdr (assoc root-name jao-vterm-repl-repls))
+ (read-string "REPL command: ")))
+ (bname (format "* vrepl - %s/%s *"
+ (file-name-base (string-remove-suffix "/" dir))
+ root-name)))
+ (jao-vterm-repl--exec cmd bname)
+ (jao-vterm-repl-mode)
+ (setq-local jao-vterm-repl--name vname)
+ (when prompt (setq-local jao-vterm-repl--prompt-rx prompt))
+ (current-buffer)))))
+
+;;;###autoload
+(defun jao-vterm-repl-register (build-file repl-cmd prompt-rx)
+ (jao-compilation-add-dominating build-file)
+ (add-to-list 'jao-vterm-repl-repls (cons build-file repl-cmd))
+ (add-to-list 'jao-vterm-repl-prompts (cons build-file prompt-rx)))
+
+;;;###autoload
+(defun jao-vterm-repl-pop-to-repl ()
+ (interactive)
+ (let ((bn (current-buffer)))
+ (pop-to-buffer (jao-vterm-repl))
+ (setq-local jao-vterm-repl--last-buffer bn)))
+
+;;;###autoload
+(defun jao-vterm-repl-pop-to-src ()
+ (interactive)
+ (when (buffer-live-p jao-vterm-repl--last-buffer)
+ (pop-to-buffer jao-vterm-repl--last-buffer)))
+
+;;;###autoload
+(defun jao-vterm-repl-send (cmd)
+ (with-current-buffer (jao-vterm-repl) (vterm-send-string cmd)))
+
+(provide 'jao-vterm-repl)
+;;; jao-vterm-repl.el ends here
diff --git a/attic/elisp/misc.el b/attic/elisp/misc.el
index 6484310..c2a6bd3 100644
--- a/attic/elisp/misc.el
+++ b/attic/elisp/misc.el
@@ -600,7 +600,7 @@
;;; eldoc for magit status/log buffers
(defun jao-magit-eldoc-for-commit (_callback)
- (when-let ((commit (magit-commit-at-point)))
+ (when-let* ((commit (magit-commit-at-point)))
(with-temp-buffer
(magit-git-insert "show"
"--format=format:%an <%ae>, %ar"
@@ -813,11 +813,6 @@
:diminish ((disable-mouse-global-mode . "")))
(global-disable-mouse-mode)
-;;; tmr
-(use-package tmr
- :ensure t
- :init
- (setq tmr-sound-file "/usr/share/sounds/freedesktop/stereo/message.oga"))
;;; pdf-tools
(use-package pdf-tools
:ensure t
@@ -892,6 +887,12 @@
"^\\*Slack - .*? : \\(MPIM: \\)?\\([^ ]+\\)\\( \\(T\\)\\)?.*" "\\2\\4")
(jao-define-attached-buffer "\\*Slack .+ Edit Message [0-9].+" 20))
+;;; alert
+(use-package alert
+ :ensure t
+ :init
+ (setq alert-default-style 'message ;; 'libnotify
+ alert-hide-all-notifications nil))
;;; snippets
(defun jao-org-notes-open-tags ()
"Search for a note file, matching all tags with completion."
@@ -902,7 +903,7 @@
(res (funcall fn)))
(while (and res tags) (setq res (seq-intersection res (funcall fn))))
(unless res (user-error "No notes found"))
- (when-let (f (completing-read "Select file: " (mapcar #'car res)))
+ (when-let* ((f (completing-read "Select file: " (mapcar #'car res))))
(find-file (cadr (assoc f res))))))
(defun jao-sway-run-or-focus-tidal ()
@@ -949,3 +950,366 @@
'notmuch-tree-match-author-face
'notmuch-tree-no-match-author-face)))
(propertize auth 'face face)))
+
+;; winttr
+
+(defun jao-weather (&optional wide)
+ (interactive "P")
+ (if (not wide)
+ (message "%s"
+ (jao-shell-string "curl -s"
+ "https://wttr.in/?format=%l++%m++%C+%c+%t+%w++%p"))
+ (jao-afio-goto-scratch)
+ (if-let ((b (get-buffer "*wttr*")))
+ (progn (pop-to-buffer b)
+ (term-send-string (get-buffer-process nil) "clear;curl wttr.in\n"))
+ (jao-exec-in-term "curl wttr.in" "*wttr*"))))
+(global-set-key (kbd "<f5>") #'jao-weather)
+
+;; so-long
+(setq large-file-warning-threshold (* 200 1024 1024))
+
+(use-package so-long
+ :ensure t
+ :diminish)
+(global-so-long-mode 1)
+
+;;;; code reviews
+(use-package code-review
+ :disabled t
+ :ensure t
+ :after forge
+ :bind (:map magit-status-mode-map
+ ("C-c C-r" . code-review-forge-pr-at-point)))
+
+;;;; jenkins
+(use-package jenkins
+ :ensure t
+ :init
+ ;; one also needs jenkins-api-token, jenkins-username and jenkins-url
+ ;; optionally: jenkins-colwidth-id, jenkins-colwidth-last-status
+ (setq jenkins-colwidth-name 35)
+ :config
+ (defun jao-jenkins-first-job (&rest _)
+ (interactive)
+ (goto-char (point-min))
+ (when (re-search-forward "^- Job" nil t)
+ (goto-char (match-beginning 0))))
+ (add-hook 'jenkins-job-view-mode-hook #'jao-jenkins-first-job)
+ (advice-add 'jenkins-job-render :after #'jao-jenkins-first-job)
+
+ (defun jenkins-refresh-console-output ()
+ (interactive)
+ (let ((n (buffer-name)))
+ (when (string-match "\\*jenkins-console-\\([^-]+\\)-\\(.+\\)\\*$" n)
+ (jenkins-get-console-output (match-string 1 n) (match-string 2 n))
+ (goto-char (point-max)))))
+
+ :bind (:map jenkins-job-view-mode-map
+ (("n" . next-line)
+ ("p" . previous-line)
+ ("f" . jao-jenkins-first-job)
+ ("RET" . jenkins--show-console-output-from-job-screen))
+ :map jenkins-console-output-mode-map
+ (("n" . next-line)
+ ("p" . previous-line)
+ ("g" . jenkins-refresh-console-output))))
+
+;;; doric themes
+(use-package doric-themes
+ :if (jao-is-darwin)
+ :ensure t
+ :demand t
+ :config
+ ;; These are the default values.
+ (setq doric-themes-to-toggle '(doric-light doric-marble))
+ (setq doric-themes-to-rotate doric-themes-collection)
+
+ (doric-themes-select 'doric-marble)
+
+ (set-face-attribute 'default nil :family "Triplicate T4c" :height 120)
+ ;; (set-face-attribute 'default nil :family "0xProto" :height 110)
+ ;; (set-face-attribute 'default nil :family "Rec Mono Casual" :height 120)
+ ;; (set-face-attribute 'default nil :family "Rec Mono Linear" :height 120)
+ ;; (set-face-attribute 'default nil :family "Rec Mono Duotone" :height 120)
+ ;; (set-face-attribute 'default nil :family "Victor Mono" :height 120)
+ ;; (set-face-attribute 'variable-pitch nil :family "Aporetic Sans" :height 1.0)
+ ;; (set-face-attribute 'fixed-pitch nil :family "Aporetic Sans Mono" :height 1.0)
+
+ :bind
+ (("<f5>" . doric-themes-toggle)
+ ("C-<f5>" . doric-themes-select)
+ ("M-<f5>" . doric-themes-rotate)))
+
+;;; gnuplot
+(use-package gnuplot
+ :disabled t
+ :ensure t
+ :commands (gnuplot-mode gnuplot-make-buffer)
+ :init (add-to-list 'auto-mode-alist '("\\.gp$" . gnuplot-mode)))
+
+;;; rdrview
+;; https://jiewawa.me/2024/04/another-way-of-integrating-mozilla-readability-in-emacs-eww/
+(define-minor-mode eww-rdrview-mode
+ "Toggle whether to use `rdrview' to make eww buffers more readable."
+ :lighter " R"
+ (if eww-rdrview-mode
+ (progn
+ (setq eww-retrieve-command '("rdrview" "-T" "title,sitename,body" "-H"))
+ (add-hook 'eww-after-render-hook #'eww-rdrview-update-title))
+ (progn
+ (setq eww-retrieve-command nil)
+ (remove-hook 'eww-after-render-hook #'eww-rdrview-update-title))))
+
+(defun eww-rdrview-update-title ()
+ "Change title key in `eww-data' with first line of buffer.
+It should be the title of the web page as returned by `rdrview'"
+ (save-excursion
+ (goto-char (point-min))
+ (plist-put eww-data :title (string-trim (thing-at-point 'line t))))
+ (eww--after-page-change))
+
+(defun eww-rdrview-toggle-and-reload ()
+ "Toggle `eww-rdrview-mode' and reload page in current eww buffer."
+ (interactive)
+ (if eww-rdrview-mode (eww-rdrview-mode -1)
+ (eww-rdrview-mode 1))
+ (eww-reload))
+
+(defun jao-eww-readable (rdrview)
+ (interactive "P" eww-mode)
+ (if rdrview
+ (eww-rdrview-toggle-and-reload)
+ (eww-readable)))
+
+;;; spotify
+(jao-load-path "espotify")
+
+(use-package espotify
+ :demand t
+ :init (setq espotify-service-name "mopidy"))
+
+(use-package consult-spotify :demand t)
+
+(defalias 'jao-streaming-album #'consult-spotify-album)
+(defalias 'jao-streaming-track #'consult-spotify-track)
+(defalias 'jao-streaming-artist #'consult-spotify-artist)
+(defalias 'jao-streaming-playlist #'consult-spotify-playlist)
+
+(jao-def-exec-in-term "ncmpcpp" "ncmpcpp" (jao-afio-goto-scratch))
+
+;;; spt
+(use-package jao-spt
+ :demand t
+ :config
+ (defun jao-spt-setup-aliases ()
+ (setq espotify-play-uri-function #'jao-spt-play-uri)
+ (defalias 'jao-streaming-list #'jao-term-spt)
+ (defalias 'jao-streaming-lyrics #'jao-spt-show-lyrics)
+ (defalias 'jao-streaming-toggle #'jao-spt-toggle)
+ (defalias 'jao-streaming-next #'jao-spt-next)
+ (defalias 'jao-streaming-prev #'jao-spt-previous)
+ (defalias 'jao-streaming-current #'jao-spt-echo-current)
+ (defalias 'jao-streaming-seek #'jao-spt-seek)
+ (defalias 'jao-streaming-seek-back #'jao-spt-seek-back)
+ (defalias 'jao-streaming-volume #'jao-spt-vol)
+ (defalias 'jao-streaming-volume-down #'jao-spt-vol-down)
+ (defalias 'jao-streaming-like #'jao-spt-like)
+ (defalias 'jao-streaming-dislike #'jao-spt-dislike)
+ (defalias 'jao-streaming-toggle-shuffle #'jao-spt-toggle-shuffle)))
+
+(jao-def-exec-in-term "spt" "spt" (jao-afio-goto-scratch))
+
+(defvar jao-spt-on t)
+
+(defun jao-streaming-toggle-player ()
+ (interactive)
+ (if jao-spt-on
+ (progn (setq jao-mpris-player "playerctld")
+ (require 'jao-mpris)
+ (jao-mpris-setup-aliases))
+ (jao-spt-setup-aliases)
+ (setq jao-mpris-player "spt"))
+ (setq jao-spt-on (not jao-spt-on))
+ (message "%s activated " jao-mpris-player))
+
+(jao-streaming-toggle-player)
+
+;;; mpd + mopidy
+(use-package jao-mpc
+ :demand t
+ :commands jao-mpc-setup)
+
+(defvar jao-mopidy-port 6669)
+(defvar jao-mpc-last-port jao-mpc-port)
+
+(defun jao-mpc-toggle-port ()
+ (interactive)
+ (setq jao-mpc-port
+ (if (equal jao-mpc-port jao-mopidy-port) 6600 jao-mopidy-port)
+ jao-mpc-last-port jao-mpc-port))
+
+(defsubst jao-mpc-mopidy-p () (equal jao-mpc-last-port jao-mopidy-port))
+
+(jao-mpc-setup jao-mopidy-port 70)
+
+(defun jao-mpc-pport (&optional mop)
+ (cond ((or mop (jao-mpc-playing-p jao-mopidy-port)) jao-mopidy-port)
+ ((jao-mpc-playing-p) 6600)
+ (t jao-mpc-last-port)))
+
+(defmacro jao-defun-play (name &optional mpc-name)
+ (let ((arg (gensym)))
+ `(defun ,(intern (format "jao-player-%s" name)) (&optional ,arg)
+ (interactive "P")
+ (,(intern (format "jao-mpc-%s" (or mpc-name name)))
+ (setq jao-mpc-last-port (jao-mpc-pport ,arg))))))
+
+(jao-defun-play toggle)
+(jao-defun-play next)
+(jao-defun-play previous)
+(jao-defun-play stop)
+(jao-defun-play echo echo-current-times)
+(jao-defun-play list show-playlist)
+(jao-defun-play info lyrics-track-data)
+(jao-defun-play browse show-albums)
+(jao-defun-play select-album)
+
+(defun jao-player-seek (delta) (jao-mpc-seek delta (jao-mpc-pport)))
+
+(defalias 'jao-player-connect 'jao-mpc-connect)
+(defalias 'jao-player-play 'jao-mpc-play)
+
+;;; org-modern
+(use-package org-modern
+ :ensure t
+ :init
+ (setq org-modern-fold-stars
+ '(("▶" . "▼") ("▷" . "▽") ("▶" . "▼") ("▹" . "▿") ("▸" . "▾")))
+
+ (define-derived-mode jao-org-inbox-mode org-mode
+ "Org inbox"
+ (org-indent-mode)
+ (org-modern-mode))
+
+ (add-to-list 'auto-mode-alist '("inbox\\.org\\'" . jao-org-inbox-mode))
+ (add-hook 'org-agenda-finalize-hook #'org-modern-agenda))
+
+;;; Gnus notify
+
+(defun jao-gnus--notify-strs ()
+ (let* ((all (jao-gnus--unread-counts))
+ (counts (cdr all))
+ (labels (seq-keep (lambda (args)
+ (apply 'jao-gnus--unread-label counts args))
+ jao-gnus-tracked-groups)))
+ (jao-when-darwin (jao-gnus--xbar-echo labels))
+ labels))
+
+(defvar jao-gnus-tracked-groups
+ (let ((feeds (thread-first
+ (directory-files mail-source-directory nil "feeds\\.[^e]")
+ (seq-difference
+ '("feeds.trove" "feeds.emacs" "feeds.emacs-devel")))))
+ `(("nnml:jao\\.bigml" "B" jao-themes-f00)
+ ("nnml:jao\\.\\(inbox\\|trove\\)" "I" jao-themes-f01)
+ ("nnml:jao.write" "W" jao-themes-warning)
+ ("nnml:jao.[^ithwb]" "J" jao-themes-dimm)
+ ("nnml:jao.hacking" "H" jao-themes-dimm)
+ ;; (,(format "^nnml:%s" (regexp-opt feeds)) "F" jao-themes-dimm)
+ ;; ("feeds\\.emacs" "E" jao-themes-dimm)
+ ("nnml:feeds\\." "F" jao-themes-dimm)
+ ("nnml:local" "l" jao-themes-dimm)
+ ("nnrss:.*" "R" jao-themes-dimm)
+ ("^\\(gwene\\|gmane\\)\\." "N" jao-themes-dimm))))
+
+(defun jao-gnus--unread-counts ()
+ (seq-reduce (lambda (r g)
+ (let ((n (gnus-group-unread (car g))))
+ (if (and (numberp n) (> n 0))
+ (cons (+ n (car r))
+ (cons (cons (car g) n) (cdr r)))
+ r)))
+ gnus-newsrc-alist
+ '(0)))
+
+(defun jao-gnus-unread-count ()
+ (seq-reduce (lambda (c g) (+ c (or (gnus-group-unread (car g)) 0)))
+ gnus-newsrc-alist
+ 0))
+
+(defun jao-gnus--unread-label (counts rx label face)
+ (let ((n (seq-reduce (lambda (n c)
+ (if (string-match-p rx (car c)) (+ n (cdr c)) n))
+ counts
+ 0)))
+ (when (> n 0) `(:propertize ,(format "%s%d " label n) face ,face))))
+
+;;; ement
+(use-package ement
+ :disabled t
+ :ensure t
+ :init (setq ement-save-sessions t
+ ement-sessions-file (locate-user-emacs-file "cache/ement.el")
+ ement-room-avatars nil
+ ement-notify-dbus-p nil
+ ement-room-left-margin-width 0
+ ement-room-right-margin-width 11
+ ement-room-timestamp-format "%H:%M"
+ ement-room-timestamp-header-format "­­--------")
+
+ :custom ((ement-room-message-format-spec "(%S) %B%r%R %t"))
+
+ :config
+ (defun jao-ement-track (event room session)
+ (when (ement-notify--room-unread-p event room session)
+ (when-let* ((n (ement-room--buffer-name room))
+ (b (get-buffer n)))
+ (tracking-add-buffer b))))
+
+ (add-hook 'ement-event-hook #'jao-ement-track)
+ (jao-shorten-modes 'ement-room-mode)
+ (jao-tracking-cleaner "^\\*Ement Room: \\(.+\\)\\*" "@\\1"))
+
+;;;; lsp
+(use-package lsp-mode
+ :disabled t
+ ;; :ensure t
+ :commands lsp
+ :custom
+ ;; what to use when checking on-save. "check" is default, I prefer clippy
+ (lsp-rust-analyzer-cargo-watch-command "clippy")
+ (lsp-eldoc-render-all t)
+ (lsp-idle-delay 0.6)
+ ;; enable / disable the hints as you prefer:
+ (lsp-inlay-hint-enable t)
+ ;; These are optional configurations. See https://emacs-lsp.github.io/lsp-mode/page/lsp-rust-analyzer/#lsp-rust-analyzer-display-chaining-hints for a full list
+ (lsp-rust-analyzer-display-lifetime-elision-hints-enable "skip_trivial")
+ (lsp-rust-analyzer-display-chaining-hints nil)
+ (lsp-rust-analyzer-display-lifetime-elision-hints-use-parameter-names nil)
+ (lsp-rust-analyzer-display-closure-return-type-hints t)
+ (lsp-rust-analyzer-display-parameter-hints nil)
+ (lsp-rust-analyzer-display-reborrow-hints nil)
+ :config
+ (add-hook 'lsp-mode-hook 'lsp-ui-mode))
+
+(use-package lsp-ui
+ :disabled t
+ ;; :ensure t
+ :commands lsp-ui-mode
+ :custom
+ (lsp-ui-peek-always-show t)
+ (lsp-ui-sideline-show-hover t)
+ (lsp-ui-doc-enable t))
+;;; xbar
+(defvar jao-notmuch-xbar-queries
+ `((:name "" :query "tag:new and not tag:draft" :face jao-themes-f00)
+ (:name "i" :query "tag:new and tag:/inbox|write|drivel/"
+ :face jao-themes-warning)))
+
+(defvar jao-notmuch-mac-xbar t)
+
+(defun jao-notmuch-xbar ()
+ (let ((cnts (notmuch-hello-query-counts jao-notmuch-xbar-queries)))
+ (jao-shell-exec (format "echo '%s | color=#8b3626 | size=11' >/tmp/xbar"
+ (mapconcat 'jao-notmuch--qstr cnts " ")))))
diff --git a/attic/elisp/nnnm.el b/attic/elisp/nnnm.el
index 552e95c..561c09e 100644
--- a/attic/elisp/nnnm.el
+++ b/attic/elisp/nnnm.el
@@ -1,6 +1,6 @@
;;; nnnm.el --- Gnus backend for notmuch -*- lexical-binding: t; -*-
-;; Copyright (C) 2021 jao
+;; Copyright (C) 2021, 2026 jao
;; Author: jao <mail@jao.io>
;; Keywords: mail
@@ -47,8 +47,8 @@
(defun nnnm--find-query (name)
- (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name))
- nnnm-saved-searches))
+ (when-let* ((s (seq-find (lambda (s) (string= (plist-get s :name) name))
+ nnnm-saved-searches)))
(plist-get s :query)))
(defun nnnm--find-message-file (id)
@@ -60,11 +60,11 @@
(defun nnnm--article-data (article group)
(cond ((stringp article) (list article))
((numberp article)
- (when-let (data (nnnm--group-data group))
+ (when-let* ((data (nnnm--group-data group)))
(elt data (1- article))))))
(defun nnnm-article-to-file (article group)
- (when-let (d (nnnm--article-data article group))
+ (when-let* ((d (nnnm--article-data article group)))
(or (cadr d) (nnnm--find-message-file (car d)))))
(defun nnnm--count (query &optional context)
@@ -117,7 +117,7 @@
(gnus-set-active (nnnm--prefixed group server) (cons 1 n)))
(defun nnnm--update-group-data (group &optional server)
- (when-let (query (nnnm--find-query group))
+ (when-let* ((query (nnnm--find-query group)))
(let* ((data (or (nnnm--group-data group)
(mapcar #'list (nnnm--search query "NOT tag:new"))))
(ids (nnnm--search query "tag:new"))
@@ -158,7 +158,7 @@
(with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (s nnnm-saved-searches)
- (when-let (query (plist-get s :query))
+ (when-let* ((query (plist-get s :query)))
(let ((name (plist-get s :name))
(total (nnnm--count query)))
(insert (format "%s %d 1 y\n" name total))))))
@@ -173,7 +173,7 @@
(if (stringp (car sequence))
'headers
(dolist (article sequence)
- (when-let (file (nnnm-article-to-file article group))
+ (when-let* ((file (nnnm-article-to-file article group)))
(insert (format "221 %d Article retrieved.\n" article))
(save-excursion (nnheader-insert-head file))
(if (re-search-forward "\n\r?\n" nil t)
generated by cgit v1.2.3 (git 2.46.0) at 2026-09-30 12:21:12 +0000