summaryrefslogtreecommitdiffhomepage
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/doc/jao-org-notes.el33
-rw-r--r--lib/eos/jao-afio.el6
-rw-r--r--lib/eos/jao-dirmon.el18
-rw-r--r--lib/eos/jao-minibuffer.el6
-rw-r--r--lib/eos/jao-r2e.el206
-rw-r--r--lib/media/jao-mpc.el3
-rw-r--r--lib/media/jao-mpris.el32
-rw-r--r--lib/media/jao-random-album.el12
-rw-r--r--lib/net/jao-eww-session.el19
-rw-r--r--lib/net/jao-notmuch-gnus.el246
-rw-r--r--lib/net/jao-notmuch.el8
-rw-r--r--lib/net/jao-url.el36
-rw-r--r--lib/net/randomsig.el9
-rw-r--r--lib/prog/jao-clojure.el101
-rw-r--r--lib/prog/jao-compilation.el4
-rw-r--r--lib/themes/jao-light-theme.el7
-rw-r--r--lib/themes/jao-themes.el34
17 files changed, 704 insertions, 76 deletions
diff --git a/lib/doc/jao-org-notes.el b/lib/doc/jao-org-notes.el
index bd82543..bd45723 100644
--- a/lib/doc/jao-org-notes.el
+++ b/lib/doc/jao-org-notes.el
@@ -1,6 +1,6 @@
;;; jao-org-notes.el --- A simple system for org note taking -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022, 2024 jao
+;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: tools
@@ -57,7 +57,11 @@
(string-to-number (cadr m))))
(defun jao-org-notes--matches (lines)
- (mapcar (lambda (l) (jao-org-notes--clean-match (split-string l "\0" t))) lines))
+ (seq-keep (lambda (l)
+ (let ((m (split-string (or l "") "\0" t)))
+ (when (and (car m) (cadr m))
+ (jao-org-notes--clean-match m))))
+ lines))
(defun jao-org-notes--grep-rx (rx &rest rg-args)
(let ((default-directory jao-org-notes-dir))
@@ -71,14 +75,15 @@
(and (string-match-p "^[^:]+ + :" m) "tags")
"titles"))
-(defun jao-org-notes--consult-rg (prompt &optional cat no-req cmd)
+(defun jao-org-notes--consult-rg (prompt &optional cat no-req cmd initial)
(let ((default-directory (expand-file-name (or cat "") jao-org-notes-dir)))
(consult--read
- (consult--async-command #'jao-org-notes--rg-title-or-tags
- (consult--async-transform jao-org-notes--matches))
+ (consult--async-pipeline
+ (consult--process-collection #'jao-org-notes--rg-title-or-tags)
+ (consult--async-transform #'jao-org-notes--matches))
:prompt prompt
- :initial (consult--async-split-initial "")
- :add-history (concat (consult--async-split-initial (thing-at-point 'symbol)))
+ :initial (or initial "")
+ :add-history (thing-at-point 'symbol)
:require-match (not no-req)
:category 'jao-org-notes-lookup
:group 'jao-org-notes--consult-group
@@ -94,9 +99,10 @@
(cond ((file-exists-p (expand-file-name cat jao-org-notes-dir)) cat)
((yes-or-no-p "New category, create?") cat))))
-(defun jao-org-notes--insert-title ()
+(defun jao-org-notes--insert-title (&optional title)
(let* ((cat (jao-org-notes--cat))
- (title (file-name-base (jao-org-notes--consult-rg "Title: " cat t)))
+ (note (jao-org-notes--consult-rg "Title: " cat t nil title))
+ (title (file-name-base note))
(title (replace-regexp-in-string "^#" "" title)))
(when (not (string-empty-p title))
(let* ((base (replace-regexp-in-string " +" "-" (downcase title)))
@@ -160,16 +166,16 @@
(interactive)
(consult-ripgrep (expand-file-name (or cat "") jao-org-notes-dir) initial))
-(defun jao-org-notes-create ()
+(defun jao-org-notes-create (&optional title)
"Create a new note file, matching tags and titles with completion."
(interactive)
- (when (jao-org-notes--insert-title)
+ (when (jao-org-notes--insert-title title)
(org-insert-time-stamp (current-time) t t "#+date: " "\n")
(insert "#+tags: :"
(mapconcat #'identity (jao-org-notes--read-tags) ":")
":\n"))
(save-buffer)
- (buffer-file-name))
+ (current-buffer))
(defun jao-org-notes-backlinks ()
"Show a list of note files linking to the current one."
@@ -210,7 +216,8 @@
(defun jao-org-notes-setup (mnemonic)
"Set up the notes system, providing a mnemonic character for its org template."
(setq org-capture-templates
- (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic))
+ (add-to-list 'org-capture-templates
+ (jao-org-notes--template mnemonic))
jao-org-notes--tags (jao-org-notes-all-tags))
(when (fboundp 'org-capture-upgrade-templates)
(org-capture-upgrade-templates org-capture-templates)))
diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el
index b588989..4506bd8 100644
--- a/lib/eos/jao-afio.el
+++ b/lib/eos/jao-afio.el
@@ -1,6 +1,6 @@
;;; jao-afio.el --- workspaces in just one frame -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022, 2024 jao
+;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: frames
@@ -122,10 +122,10 @@
;;;###autoload
(defun jao-afio-open-gnus ()
(interactive)
- (delete-other-windows)
(jao-org-agenda)
(calendar)
(find-file (expand-file-name "inbox.org" org-directory))
+ (delete-other-windows)
(gnus)
(jao-gnus--set-summary-line))
@@ -228,7 +228,7 @@
(defun jao-afio-goto-scratch (&optional one-win)
(interactive "P")
- (jao-afio--goto-frame ?s nil)
+ (jao-afio--goto-frame ?s one-win)
(when one-win (delete-other-windows)))
(defun jao-afio-goto-chats (&optional reset)
diff --git a/lib/eos/jao-dirmon.el b/lib/eos/jao-dirmon.el
index 9d748d1..6a897d3 100644
--- a/lib/eos/jao-dirmon.el
+++ b/lib/eos/jao-dirmon.el
@@ -1,6 +1,6 @@
;;; jao-dirmon.el --- little utility to monitor disk usage -*- lexical-binding: t; -*-
-;; Copyright (C) 2022 jao
+;; Copyright (C) 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: tools
@@ -25,12 +25,18 @@
;;; Code:
(require 'multisession)
+(require 'view)
(require 'jao-shell)
(define-multisession-variable jao-dirmon-last '())
+(defvar jao-dirmon-roots '("/var/local" "~"))
+
(defun jao-dirmon-dirs ()
- (jao-shell-cmd-lines "find ~ -mindepth 2 -maxdepth 3 -type d"))
+ (mapcan (lambda (d)
+ (jao-shell-cmd-lines
+ (format "find %s -mindepth 2 -maxdepth 3 -type d" d)))
+ jao-dirmon-roots))
(defun jao-dirmon-sizes ()
(mapcar (lambda (f)
@@ -40,9 +46,12 @@
(defvar jao-dirmon-threshold 100)
(defvar jao-dirmon-last-delta nil)
+(defvar jao-dirmon-buffer "*jao-dirmon")
(defun jao-dirmon--show-deltas (old current deltas)
- (with-temp-buffer
+ (with-current-buffer (get-buffer-create jao-dirmon-buffer)
+ (view-mode-disable)
+ (delete-region (point-min) (point-max))
(insert "High deltas since " (car old) "\n\n")
(dolist (d (seq-sort-by #'cdr #'> deltas))
(insert (format "- %s: %s Mb\n" (car d) (cdr d))))
@@ -52,6 +61,7 @@
(seq-sort-by #'cdr #'> current)))
(insert (format "- %s: %s Mb\n" (car c) (cdr c)))))
(beginning-of-buffer)
+ (view-mode-enable)
(pop-to-buffer (current-buffer) nil t)
(when (y-or-n-p "Save current state?")
(setf (multisession-value jao-dirmon-last)
@@ -66,7 +76,7 @@
(dolist (c current)
(let ((d (- (cdr c) (alist-get (car c) old 0 nil #'string=))))
(when (> (abs d) jao-dirmon-threshold)
- (push c high))))
+ (push (cons (car c) d) high))))
(setq jao-dirmon-last-delta high)
(jao-dirmon--show-deltas old current jao-dirmon-last-delta)
jao-dirmon-last-delta))
diff --git a/lib/eos/jao-minibuffer.el b/lib/eos/jao-minibuffer.el
index 77bd49a..6cd5b24 100644
--- a/lib/eos/jao-minibuffer.el
+++ b/lib/eos/jao-minibuffer.el
@@ -1,6 +1,6 @@
;;; jao-minibuffer.el --- using the minibuffer to report status -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022, 2024 jao
+;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: extensions
@@ -40,7 +40,7 @@
(defun jao-minibuffer--trim (s w)
(if (< (string-width (or s "")) w)
(format (format "%%%ds" (if jao-minibuffer-align-right w (- w))) s)
- (substring s 0 w)))
+ (substring s 0 (min w (string-width s)))))
(defun jao-minibuffer--width ()
(cond ((numberp jao-minibuffer-frame-width) jao-minibuffer-frame-width)
@@ -97,7 +97,7 @@
info))
(sep (if msg " - " ""))
(pref (when info
- (let ((len (+ (length info) (length sep))))
+ (let ((len (+ (string-width info) (string-width sep))))
(format (format "\n%%%ds" len) ""))))
(msg (if (and msg pref)
(replace-regexp-in-string "\n" pref msg)
diff --git a/lib/eos/jao-r2e.el b/lib/eos/jao-r2e.el
new file mode 100644
index 0000000..fa20ddb
--- /dev/null
+++ b/lib/eos/jao-r2e.el
@@ -0,0 +1,206 @@
+;;; jao-r2e.el --- List of rss2email subscriptions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
+;; Keywords: news
+
+;; 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/>.
+
+(require 'jao-url)
+
+(autoload 'View-quit "view")
+(autoload 'eww-view-source "eww")
+(autoload 'jao-notmuch-subtags "jao-notmuch")
+
+(defvar jao-r2e-confirm-toggle nil)
+
+(defconst jao-r2e--buffer "*r2e*")
+(defun jao-r2e--buffer ()
+ (with-current-buffer (get-buffer-create jao-r2e--buffer)
+ (unless (derived-mode-p 'jao-r2e-mode)
+ (jao-r2e-mode))
+ (current-buffer)))
+
+(defvar jao-r2e-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 [?N] 'jao-r2e-next)
+ (define-key map [?P] 'jao-r2e-prev)
+ (define-key map [?g] 'jao-r2e-list)
+ (define-key map [?s] 'jao-r2e-subscribe)
+ (define-key map [?t] 'jao-r2e-toggle)
+ (define-key map [?D] 'jao-r2e-delete)
+ (define-key map [?u] 'jao-r2e-recover)
+ map))
+
+;;;###autoload
+(defun jao-r2e-mode ()
+ "A very simple mode to show the output of r2e commands."
+ (interactive)
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map jao-r2e-mode-map)
+ ;; (setq-local font-lock-defaults '(jao-r2e-font-lock-keywords))
+ (setq-local truncate-lines t)
+ (setq-local next-line-add-newlines nil)
+ (setq major-mode 'jao-r2e-mode)
+ (setq mode-name "r2e")
+ (read-only-mode 1))
+
+(defun jao-r2e--do (things &optional buffer)
+ "Execute a r2e command THINGS in the given BUFFER."
+ (let ((b (or buffer (pop-to-buffer (jao-r2e--buffer)))))
+ (let ((inhibit-read-only t)
+ (cmd (format "r2e %s" things)))
+ (unless buffer
+ (with-current-buffer b (delete-region (point-min) (point-max))))
+ (with-temp-message (format "Running: %s ...." cmd)
+ (shell-command cmd b))
+ (unless buffer (read-only-mode 1)))))
+
+(defconst jao-r2e--feed-rx
+ "^\\([0-9]+\\): \\[\\( \\|\\*\\)\\] \\([^ ]+\\) (\\(.+\\) -> \\(.+\\))")
+
+(defun jao-r2e--feed-at-point ()
+ (beginning-of-line)
+ (when-let* ((m (looking-at jao-r2e--feed-rx)))
+ (list (match-string 1)
+ (match-string 3)
+ (string= "*" (match-string 2))
+ (match-string 4)
+ (match-string 5))))
+
+(defun jao-r2e ()
+ (interactive)
+ (pop-to-buffer (jao-r2e--buffer))
+ (when (looking-at-p "^$")
+ (jao-r2e-list)))
+
+(defun jao-r2e-list ()
+ (interactive)
+ (jao-r2e--do "list"))
+
+(defun jao-r2e--srx (opp)
+ (when-let* ((f (jao-r2e--feed-at-point)))
+ (let ((a (if opp (not (caddr f)) (caddr f))))
+ (format "^[0-9]+: \\[%s\\] " (if a "\\*" " ")))))
+
+(defun jao-r2e-next (opp)
+ "Next feed with the same (or opposite) status."
+ (interactive "P")
+ (when-let* ((rx (jao-r2e--srx opp)))
+ (next-line)
+ (when (re-search-forward rx nil t)
+ (beginning-of-line))))
+
+(defun jao-r2e-prev (opp)
+ "Previous feed with the same (or opposite) status."
+ (interactive "P")
+ (when-let* ((rx (jao-r2e--srx opp)))
+ (when (re-search-backward rx nil t)
+ (beginning-of-line))))
+
+(defun jao-r2e-toggle ()
+ (interactive)
+ (let ((f (jao-r2e--feed-at-point)))
+ (unless f (error "No feed at point"))
+ (let ((p (point))
+ (no (car f))
+ (name (cadr f))
+ (act (if (caddr f) "pause" "unpause")))
+ (when (or (not jao-r2e-confirm-toggle)
+ (yes-or-no-p (format "%s '%s'? " act name)))
+ (with-temp-buffer
+ (jao-r2e--do (format "%s %s" act no) (current-buffer)))
+ (jao-r2e-list)
+ (goto-char p)))))
+
+(persist-defvar jao-r2e-deleted-feeds '()
+ "List of rss2email feeds deleted at some point.")
+
+(defun jao-r2e-delete ()
+ "Delete feed at point. Use `jao-r2e-recover' to undelete."
+ (interactive)
+ (let ((f (jao-r2e--feed-at-point)))
+ (unless f (error "No feed at point"))
+ (let ((p (point))
+ (no (car f))
+ (name (cadr f)))
+ (when (yes-or-no-p (format "Delete feed '%s'" name))
+ (add-to-list 'jao-r2e-deleted-feeds (cdr f))
+ (with-temp-buffer
+ (jao-r2e--do (format "delete %s" no) (current-buffer)))
+ (jao-r2e-list)
+ (goto-char p)))))
+
+(defun jao-r2e-recover ()
+ (interactive)
+ (when (seq-empty-p jao-r2e-deleted-feeds)
+ (error "No feeds recoverable at this point."))
+ (let ((feed (completing-read "Recover feed: " jao-r2e-deleted-feeds)))
+ (when-let* ((ps (assoc feed jao-r2e-deleted-feeds))
+ (url (caddr ps))
+ (mail (car (last ps)))
+ (cat (when (string-match "feeds\\.\\(.+\\)@localhost" mail)
+ (match-string 1 mail))))
+ (jao-r2e-subscribe (list url feed) cat t)
+ (setq jao-r2e-deleted-feeds (remove ps jao-r2e-deleted-feeds)))))
+
+(defun jao-r2e--find-url ()
+ (save-excursion
+ (when (derived-mode-p 'w3m-mode 'eww-mode)
+ (if (fboundp 'w3m-view-source) (w3m-view-source) (eww-view-source)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "type=\"application/\\(?:atom\\|rss\\)\\+xml\" +" nil t)
+ (let ((url (save-excursion
+ (when (re-search-forward
+ "href=\"\\([^\n\"]+\\)\"" nil t)
+ (match-string-no-properties 1))))
+ (title (when (re-search-forward
+ "\\(?:title=\"\\([^\n\"]+\\)\" +\\)" nil t)
+ (match-string-no-properties 1))))
+ (cond ((derived-mode-p 'w3m-view-mode) (w3m-view-source))
+ ((string-match-p ".*\\*eww-source\\b.*" (buffer-name))
+ (View-quit)))
+ (when url (cons url (or title "")))))))
+
+(defun jao-r2e-subscribe (url &optional cat relist)
+ "Subscribe to a given RSS URL. If URL not given, look for it."
+ (interactive (list (or (jao-url-around-point)
+ (jao-r2e--find-url)
+ (read-string "Feed URL: "))))
+ (let* ((url+title (ensure-list url))
+ (url (car url+title))
+ (title (cdr url+title)))
+ (unless url (error "No feeds found"))
+ (let ((url (if (string-match "^feed:" url) (substring url 5) url)))
+ (when (y-or-n-p (format "Subscribe to <%s>? " url))
+ (let* ((name (read-string "Feed name: " title))
+ (cats (cons "prog" (jao-notmuch-subtags "feeds")))
+ (cat (completing-read "Category: " cats nil t cat))
+ (subs (format "r2e add %s '%s' feeds.%s@localhost"
+ name url cat)))
+ (with-temp-message "Subscribing..."
+ (shell-command-to-string subs))
+ (with-temp-message "Retrieving feed..."
+ (shell-command (format "r2e run %s" name)))
+ (when relist (jao-r2e-list)))))))
+
+(provide 'jao-r2e)
+;;; jao-r2e.el ends here
diff --git a/lib/media/jao-mpc.el b/lib/media/jao-mpc.el
index 0f000da..4f5081c 100644
--- a/lib/media/jao-mpc.el
+++ b/lib/media/jao-mpc.el
@@ -311,8 +311,7 @@
(setq jao-lyrics-info-function #'jao-mpc-lyrics-track-data)
(jao-random-album-setup #'jao-mpc--album-buffer
#'jao-mpc--add-and-play
- #'jao-mpc-stop
- jao-notify-audio-icon)
+ #'jao-mpc-stop)
(let ((jao-random-album-active nil)) (jao-mpc-connect))
(when secondary-port (jao-mpc-connect secondary-port))
(when priority
diff --git a/lib/media/jao-mpris.el b/lib/media/jao-mpris.el
index 3bb2636..80d0675 100644
--- a/lib/media/jao-mpris.el
+++ b/lib/media/jao-mpris.el
@@ -1,6 +1,6 @@
;;; jao-mpris.el --- mpris players control -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022, 2024 jao
+;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: multimedia
@@ -158,25 +158,25 @@
(defun jao-mpris--handler (iname properties &rest _args)
(let ((inhibit-message t))
- (message "Received properties: %S from %s" properties iname))
- (when-let (md (caadr (assoc "Metadata" properties)))
- (let ((tno (caadr (assoc "xesam:trackNumber" md)))
- (tlt (caadr (assoc "xesam:title" md)))
- (art (caadr (assoc "xesam:artist" md)))
- (alb (caadr (assoc "xesam:album" md)))
- (len (caadr (assoc "mpris:length" md))))
- (if (string= (or tlt "") "TIDAL")
- (jao-mpris-reset)
+ (message "Received properties: %S from %s" properties iname)
+ (when-let (md (caadr (assoc "Metadata" properties)))
+ (let ((tno (caadr (assoc "xesam:trackNumber" md)))
+ (tlt (caadr (assoc "xesam:title" md)))
+ (art (caadr (assoc "xesam:artist" md)))
+ (alb (caadr (assoc "xesam:album" md)))
+ (len (caadr (assoc "mpris:length" md))))
(jao-mpris--set-current 'track tno)
(jao-mpris--set-current 'title tlt)
(jao-mpris--set-current 'artist art)
(jao-mpris--set-current 'album alb)
- (jao-mpris--set-current 'length len))))
- (when-let (st (caadr (assoc "PlaybackStatus" properties)))
- (jao-mpris--set-current 'status st)
- (when (string= st "Stopped")
- (dolist (k '(track title artist album length))
- (jao-mpris--del-current k))))
+ (jao-mpris--set-current 'length len)))
+ (when-let (st (caadr (assoc "PlaybackStatus" properties)))
+ (jao-mpris--set-current 'status st)
+ (when (string= st "Stopped")
+ (dolist (k '(track title artist album length))
+ (jao-mpris--del-current k))))
+ ;; (message "Current is: %S" jao-mpris--current)
+ )
(jao-mpris--track jao-mpris--current))
;;;###autoload
diff --git a/lib/media/jao-random-album.el b/lib/media/jao-random-album.el
index 5b10308..3b2915b 100644
--- a/lib/media/jao-random-album.el
+++ b/lib/media/jao-random-album.el
@@ -18,13 +18,10 @@
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-(require 'jao-notify)
-
(defvar jao-random-album-active t)
(defvar jao-random-lines nil)
(defvar jao-random-lines-file (expand-file-name "~/.emacs.d/random-lines"))
-(defvar jao-random-album-notify t)
-(defvar jao-random-album-notify-icon jao-notify-audio-icon)
+(defvar jao-random-album-notify nil)
(defvar jao-random-album-skip-lines 2)
(defun jao-random-lines ()
@@ -81,18 +78,17 @@
(let ((album (string-trim (thing-at-point 'line))))
(funcall jao-random-album-add-tracks-and-play album)
(when jao-random-album-notify
- (jao-notify album "Next album" jao-random-album-notify-icon)))))
+ (funcall jao-random-album-notify album)))))
(defun jao-random-album-reset ()
(interactive)
(setq jao-random-lines nil)
(jao-random-lines-save))
-(defun jao-random-album-setup (album-buffer add-and-play stop &optional icon)
+(defun jao-random-album-setup (album-buffer add-and-play stop)
(setq jao-random-album-buffer album-buffer
jao-random-album-add-tracks-and-play add-and-play
- jao-random-album-stop stop
- jao-random-album-notify-icon icon))
+ jao-random-album-stop stop))
(provide 'jao-random-album)
diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el
index 4ac5447..da5bc8b 100644
--- a/lib/net/jao-eww-session.el
+++ b/lib/net/jao-eww-session.el
@@ -1,6 +1,6 @@
;;; jao-eww-session.el --- Persistent eww sessions -*- lexical-binding: t; -*-
-;; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009, 2012, 2021, 2022 Jose A Ortega Ruiz
+;; Copyright (C) 2003-2004, 2006-2009, 2012, 2021-2022, 2025 Jose A Ortega Ruiz
;; Author: Jose A Ortega Ruiz <jao@gnu.org>
;; Version: 0.4
@@ -168,15 +168,14 @@ the session is already displayed in a eww tab, jao-eww-session can:
(defun jao-eww-session--to--file (filename &optional skip)
(require 'pp)
- (when (jao-eww-session-not-empty)
- (let ((inhibit-message t)
- (session (jao-eww-session--update-current skip)))
- (with-temp-buffer
- (insert ";;;; File generated by jao-eww-session. DO NOT EDIT!\n")
- (pp session (current-buffer))
- (insert "\n" ";;;; End of "
- (file-name-nondirectory jao-eww-session-file) "\n")
- (write-region (point-min) (point-max) (expand-file-name filename))))))
+ (let ((inhibit-message t)
+ (session (jao-eww-session--update-current skip)))
+ (with-temp-buffer
+ (insert ";;;; File generated by jao-eww-session. DO NOT EDIT!\n")
+ (pp session (current-buffer))
+ (insert "\n" ";;;; End of "
+ (file-name-nondirectory jao-eww-session-file) "\n")
+ (write-region (point-min) (point-max) (expand-file-name filename)))))
(defun jao-eww-session--backup-name (fname)
(concat (expand-file-name fname) ".bak"))
diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el
new file mode 100644
index 0000000..5cd42fa
--- /dev/null
+++ b/lib/net/jao-notmuch-gnus.el
@@ -0,0 +1,246 @@
+;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022, 2024, 2025 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: mail
+
+;; 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:
+
+;; Helper functions to work in Gnus with mail indexed by notmuch.
+
+;;; Code:
+
+(require 'gnus)
+(require 'ol-gnus)
+(require 'notmuch-show)
+
+;;; Tagging in notmuch from Gnus buffers
+
+(defun jao-notmuch-gnus--notmuch-id (id)
+ (when id (if (string-match "<\\(.+\\)>" id) (match-string 1 id) id)))
+
+(defun jao-notmuch-gnus-message-id (&optional no-show)
+ "Find the id of currently selected message in Gnus or notmuch."
+ (when (and (not no-show) (derived-mode-p 'gnus-summary-mode))
+ (save-window-excursion (gnus-summary-show-article)))
+ (cond (gnus-original-article-buffer
+ (with-current-buffer gnus-original-article-buffer
+ (jao-notmuch-gnus--notmuch-id (message-field-value "message-id"))))
+ ((derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode)
+ (notmuch-show-get-message-id))))
+
+(defun jao-notmuch-gnus-message-tags (id)
+ "Ask notmuch for the tags of a message with the given ID."
+ (let ((cmd (format "notmuch search --output=tags 'id:%s'" id)))
+ (split-string (shell-command-to-string cmd))))
+
+(defun jao-notmuch-gnus-tag-message (&optional id tags no-log)
+ "Interactively add or remove tags to the current message."
+ (interactive)
+ (let* ((id (or id (jao-notmuch-gnus-message-id)))
+ (current (or tags (jao-notmuch-gnus-message-tags id)))
+ (prompt (format "Change tags %s" (string-join current "/")))
+ (tags (or tags (notmuch-read-tag-changes current prompt))))
+ (notmuch-tag (concat "id:" id) tags)
+ (unless no-log
+ (message "%s -> %s" current (jao-notmuch-gnus-message-tags id)))))
+
+(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))
+ (message "%s" (string-join (jao-notmuch-gnus-message-tags id) " "))))
+
+(jao-transient-major-mode+ gnus-summary
+ ["Tags"
+ ("s" "show message tags" jao-notmuch-gnus-show-tags)
+ ("t" "tag message" jao-notmuch-gnus-tag-message)])
+
+(defun jao-notmuch-gnus-toggle-tags (tags &optional id current)
+ "Toggle the given TAGS list for the current Gnus message."
+ (let* ((id (or id (jao-notmuch-gnus-message-id)))
+ (current (or current (jao-notmuch-gnus-message-tags id)))
+ (tags (mapcar (lambda (x)
+ (concat (if (member x current) "-" "+") x))
+ tags)))
+ (notmuch-tag (concat "id:" id) tags)
+ (message "New tags: %s" (jao-notmuch-gnus-message-tags id))))
+
+(defun jao-notmuch-gnus-tag-mark ()
+ "Remove the new and unread tags for an article when it's marked as seen by Gnus."
+ (when-let (id (jao-notmuch-gnus-message-id t))
+ (jao-notmuch-gnus-tag-message id '("-new" "-unread") t)))
+
+(add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark)
+
+(defun jao-notmuch-gnus--group-tags (group)
+ (when (string-match ".+:\\(.+\\)" group)
+ (split-string (match-string 1 group) "\\.")))
+
+(defun jao-notmuch-gnus-tag-on-move (op headers from to _d)
+ (when-let* ((to-tags (when to (jao-notmuch-gnus--group-tags to)))
+ (id (jao-notmuch-gnus--notmuch-id (mail-header-id headers))))
+ (if (eq op 'delete)
+ (let ((cur (seq-difference (jao-notmuch-gnus--group-tags from) to-tags)))
+ (jao-notmuch-gnus-toggle-tags (append cur to-tags) id cur))
+ (notmuch-tag (concat "id:" id)
+ (mapcar (lambda (x) (concat "+" x)) to-tags)))))
+
+(defun jao-notmuch-gnus-auto-tag ()
+ (add-hook 'gnus-summary-article-move-hook #'jao-notmuch-gnus-tag-on-move)
+ (add-hook 'gnus-summary-article-expire-hook #'jao-notmuch-gnus-tag-on-move))
+
+;;; Gnus search using notmuch
+
+(require 'gnus-search)
+
+(add-to-list 'gnus-search-expandable-keys "list")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr (head list)))
+ (format "List:%s" (gnus-search-transform-expression engine (cdr expr))))
+
+
+;;; Displaying search results in Gnus
+
+(defvar jao-notmuch-gnus-server "nnml"
+ "Name of the target Gnus server, e.g. nnml+mail.")
+
+(defvar jao-notmuch-gnus-mail-directory (expand-file-name "~/var/mail/gnus")
+ "Directory where Gnus stores its mail.")
+
+(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/mail/news")
+ "Directory where leafnode stores its messages as seen by notmuch.")
+
+(defun jao-notmuch-gnus-file-to-group (file &optional maildir newsdir)
+ "Compute the Gnus group name from the given file name.
+Example:
+
+ IN: /home/jao/var/mail/jao/foo/cur/1259184569.M4818P3384.localhost,W=6921:2,S
+ OUT: nnml:jao.foo
+
+ IN: /home/jao/.emacs.d/gnus/Mail/jao.trove/32, /home/jao/.emacs.d/gnus/Mail/
+ OUT: nnml:jao.trove
+
+ IN: /home/jao/var/mail/gmane/foo/bar/100
+ OUT: nntp:gmane.foo.bar
+
+ IN: /home/jao/var/mail/bigml/cur/1259176906.M17483P24679.localhost,W=2488:2,S
+ OUT:nnimap:bigml/inbox"
+ (let* ((maildir (or maildir jao-notmuch-gnus-mail-directory))
+ (newsdir (or newsdir jao-notmuch-gnus-leafnode-directory))
+ (g (directory-file-name (file-name-directory file)))
+ (g (replace-regexp-in-string (file-name-as-directory maildir) "" g))
+ (g (replace-regexp-in-string (file-name-as-directory newsdir) "" g))
+ (nntp (string-match-p "^\\(gmane\\|gwene\\)/" g))
+ (g (cond (nntp (concat "nntp:" g))
+ ((file-name-directory g)
+ (replace-regexp-in-string "^\\([^/]+\\)/"
+ (concat jao-notmuch-gnus-server
+ ":\\1/")
+ (file-name-directory g) t))
+ (t (concat jao-notmuch-gnus-server ":" g))))
+ (g (replace-regexp-in-string "/" "." g))
+ (g (replace-regexp-in-string "[/.]$" "" g)))
+ (cond ((string-match ":$" g) (concat g "inbox"))
+ (nntp g)
+ (t (replace-regexp-in-string ":\\." ":" g)))))
+
+(defun jao-notmuch-gnus-id-to-file (id)
+ (when id
+ (let ((cmd (format "notmuch search --output=files %s" id)))
+ (string-trim (shell-command-to-string cmd)))))
+
+(defun jao-notmuch-gnus-goto-message (&optional msg-id filename)
+ "Open a summary buffer containing the current notmuch article."
+ (interactive)
+ (let* ((filename (or filename
+ (jao-notmuch-gnus-id-to-file msg-id)
+ (notmuch-show-get-filename)))
+ (group (when filename (jao-notmuch-gnus-file-to-group filename)))
+ (msg-id (or msg-id (notmuch-show-get-message-id)))
+ (msg-id (when msg-id (replace-regexp-in-string "^id:" "" msg-id))))
+ (if (and group msg-id)
+ (org-gnus-follow-link group msg-id)
+ (message "Couldn't get relevant infos for switching to Gnus."))))
+
+(defun jao-notmuch-gnus-engine (prefix config)
+ (let ((prefix (file-name-as-directory (expand-file-name prefix "~")))
+ (config (expand-file-name config gnus-home-directory)))
+ `(gnus-search-engine gnus-search-notmuch
+ (remove-prefix ,prefix)
+ (config-file ,config))))
+
+;;; Org links
+(defun jao-notmuch-gnus--fname (id)
+ (let ((cmd (format "notmuch search --output=files id:%s" id)))
+ (car (split-string (shell-command-to-string cmd)))))
+
+(defun jao-notmuch-gnus-org-follow (id)
+ (when-let* ((fname (jao-notmuch-gnus--fname id))
+ (group (jao-notmuch-gnus-file-to-group fname)))
+ (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)))))
+ (org-link-store-props :type "mail"
+ :link (concat "mail:" (car d))
+ :description (concat "Mail: " (cdr d)))))
+
+(org-link-set-parameters "mail"
+ :follow #'jao-notmuch-gnus-org-follow
+ :store #'jao-notmuch-gnus-org-store)
+
+(org-link-set-parameters "gnus" :store #'ignore)
+(org-link-set-parameters "notmuch" :store #'ignore)
+
+;;; consult-notmuch
+
+(with-eval-after-load "consult-notmuch"
+ (defun jao-notmuch-gnus--open-candidate (candidate)
+ "Open a notmuch-search completion candidate email in Gnus."
+ (message "candidate: %S" candidate)
+ (jao-notmuch-gnus-goto-message (consult-notmuch--candidate-id candidate)))
+
+ (defun jao-gnus-consult-notmuch ()
+ "Run a consult-notmuch query that opens candidates in Gnus."
+ (interactive)
+ (jao-notmuch-gnus--open-candidate (consult-notmuch--search)))
+
+ (consult-customize jao-gnus-consult-notmuch :preview-key 'any))
+
+;;; tags and flags
+
+(defun jao-notmuch-gnus-flag-current (&rest _)
+ (jao-notmuch-gnus-tag-message nil '("+flagged") t))
+
+(defun jao-notmuch-gnus-unflag-current (&rest _)
+ (jao-notmuch-gnus-tag-message nil '("-flagged") t))
+
+(advice-add 'gnus-summary-tick-article-forward
+ :before #'jao-notmuch-gnus-flag-current)
+(advice-add 'gnus-summary-mark-as-read-forward
+ :before #'jao-notmuch-gnus-unflag-current)
+
+;;; .
+(provide 'jao-notmuch-gnus)
+;;; jao-notmuch-gnus.el ends here
diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el
index aef9757..75ee027 100644
--- a/lib/net/jao-notmuch.el
+++ b/lib/net/jao-notmuch.el
@@ -1,6 +1,6 @@
;;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*-
-;; Copyright (C) 2021, 2022, 2023, 2024 jao
+;; Copyright (C) 2021, 2022, 2023, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: mail
@@ -339,6 +339,12 @@
(let ((tags (plist-get (notmuch-tree-get-message-properties) :orig-tags)))
(jao-notmuch-tree--tag tags nil)))
+(defun jao-notmuch-subtags (tag &rest excl)
+ (let* ((cmd (concat "notmuch search --output=tags tag:" tag))
+ (ts (split-string (shell-command-to-string cmd))))
+ (seq-difference ts (append jao-notmuch--shared-tags (cons tag excl)))))
+
+
;;; fcc
(defvar jao-notmuch-mua-reply-not-inherited
'("attachment" "sent" "new" "bigml" "jao" "trove"))
diff --git a/lib/net/jao-url.el b/lib/net/jao-url.el
new file mode 100644
index 0000000..9e58f99
--- /dev/null
+++ b/lib/net/jao-url.el
@@ -0,0 +1,36 @@
+;;; jao-url.el --- URL handling -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
+;; Keywords: hypermedia
+
+;; 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/>.
+
+(require 'shr)
+(require 'ffap)
+(require 'thingatpt)
+
+(defun jao-url-around-point (&optional current-url)
+ (or (and (fboundp 'w3m-anchor) (w3m-anchor))
+ (shr-url-at-point nil)
+ (ffap-url-at-point)
+ (thing-at-point 'url)
+ (when current-url
+ (or (and (fboundp 'w3m-anchor) (w3m-anchor))
+ (and (derived-mode-p 'eww-mode) (plist-get eww-data :url))))))
+
+
+(provide 'jao-url)
+;;; jao-url.el ends here
diff --git a/lib/net/randomsig.el b/lib/net/randomsig.el
index cb37694..05b95ab 100644
--- a/lib/net/randomsig.el
+++ b/lib/net/randomsig.el
@@ -1,6 +1,6 @@
;;; randomsig.el --- insert a randomly selected signature
-;; Copyright (C) 2001, 2002, 2013, 2020, 2021 Hans-Jürgen Ficker
+;; Copyright (C) 2001, 2002, 2013, 2020, 2021, 2024 Hans-Jürgen Ficker
;; Emacs Lisp Archive Entry
;; Author: Hans-Juergen Ficker <hj@backmes.de>
@@ -277,8 +277,11 @@ You probably want to have a newline at the end of it."
(defun randomsig-prompt (&optional prompt)
;; Prompt for a signature file.
(let ((files (randomsig-files-to-list randomsig-files)))
- (completing-read (if prompt prompt "signature: ")
- (mapcar 'list files) nil t nil randomsig-history (car files))))
+ (if (cdr files)
+ (completing-read (if prompt prompt "signature: ")
+ (mapcar 'list files) nil t nil
+ randomsig-history (car files))
+ (car files))))
(defun randomsig-read-signatures-to-buffer (buffer-name &optional files)
;; read the signatures into the signature buffer
diff --git a/lib/prog/jao-clojure.el b/lib/prog/jao-clojure.el
new file mode 100644
index 0000000..e044f9e
--- /dev/null
+++ b/lib/prog/jao-clojure.el
@@ -0,0 +1,101 @@
+;;; jao-clojure.el --- Clojure utilities -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
+;; Keywords: languages
+
+;; 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 for clojure coding
+
+;;; Code:
+
+(require 'clojure-mode)
+(require 'project)
+
+;;;; Jumping between implementation and test files
+(defun jao-clojure--ext-dir (prefix)
+ (let* ((ext (file-name-extension buffer-file-name))
+ (ext-rx (format "/%s/" ext)))
+ (if (string-match-p ext-rx buffer-file-name)
+ (format "%s/%s" prefix ext)
+ prefix)))
+
+(defun jao-clojure-find-current-test ()
+ (save-excursion
+ (and (re-search-backward
+ "(deftest\\(?:\\W+^:\\w+\\)*\\W+\\b\\(.+\\)\\b" nil t)
+ (match-string-no-properties 1))))
+
+(defvar jao-clojure--src-candidates '("lib" "src" "srv" "app"))
+
+(defun jao-clojure--test-namespace-p (ns)
+ (or (string-suffix-p "-test" ns)
+ (string-match "\\(.+\\)\\.\\(test\\)\\(\\..+\\)" ns)))
+
+(defun jao-clojure-test-buffer-p ()
+ (jao-clojure--test-namespace-p (clojure-find-ns)))
+
+(defun jao-clojure--test-for (namespace sep)
+ (funcall cider-test-infer-test-ns namespace))
+
+(defun jao-clojure--infer-test-ns (ns)
+ (if (jao-clojure--test-namespace-p ns)
+ ns
+ (jao-clojure--test-for ns ".")))
+
+(defun jao-clojure--root () (project-root (project-current)))
+
+(defun jao-clojure-jump-to-test ()
+ "Jump from implementation to test file."
+ (interactive)
+ (let* ((f (format "%s/%s/%s.%s"
+ (jao-clojure--root)
+ (jao-clojure--ext-dir "test")
+ (jao-clojure--test-for (clojure-find-ns) "/")
+ (file-name-extension buffer-file-name)))
+ (f (replace-regexp-in-string "-" "_" f)))
+ (find-file f)))
+
+(defun jao-clojure--implementation-for (namespace)
+ (let ((n (replace-regexp-in-string "-test$" "" namespace)))
+ (replace-regexp-in-string "\\.test\\." "." n)))
+
+(defun jao-clojure--find-implementation (src)
+ (let ((f (format "%s/%s/%s.%s"
+ (jao-clojure--root)
+ (jao-clojure--ext-dir src)
+ (jao-clojure--implementation-for (clojure-find-ns))
+ (file-name-extension buffer-file-name))))
+ (and (file-exists-p f) f)))
+
+(defun jao-clojure-jump-to-implementation ()
+ "Jump from test file to implementation."
+ (interactive)
+ (let ((impl (car (seq-keep #'jao-clojure--find-implementation
+ jao-clojure--src-candidates))))
+ (if impl (find-file impl) (message "No implementation file found"))))
+
+(defun jao-clojure-other-file ()
+ "Toggle between implementation and test file"
+ (interactive)
+ (if (jao-clojure-test-buffer-p)
+ (jao-clojure-jump-to-implementation)
+ (jao-clojure-jump-to-test)))
+
+(provide 'jao-clojure)
+;;; jao-clojure.el ends here
diff --git a/lib/prog/jao-compilation.el b/lib/prog/jao-compilation.el
index c099701..e15c1e1 100644
--- a/lib/prog/jao-compilation.el
+++ b/lib/prog/jao-compilation.el
@@ -1,6 +1,6 @@
;;; jao-compilation.el --- utilities to lauch compilations -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022 jao
+;; Copyright (C) 2020, 2021, 2022, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: convenience
@@ -109,7 +109,7 @@
(defun jao-compilation-setup ()
(jao-compilation-add-dominating
"Makefile" "makefile" "configure.ac" "bootstrap.sh" "aclocal.m4"
- "project.clj" "build.xml" "pom.xml" "setup.py" "stack.yaml")
+ "deps.edn" "project.clj" "build.xml" "pom.xml" "setup.py" "stack.yaml")
(with-eval-after-load "project"
(add-to-list 'project-find-functions #'jao-find-compilation-root t)))
diff --git a/lib/themes/jao-light-theme.el b/lib/themes/jao-light-theme.el
index a172f84..612c44d 100644
--- a/lib/themes/jao-light-theme.el
+++ b/lib/themes/jao-light-theme.el
@@ -18,7 +18,7 @@
(jao-define-custom-theme jao-light
(:names (bg-lightest "gray98")
- (bg-light "gray95")
+ (bg-light "#efefef")
(light-gray "gray80")
@@ -36,9 +36,6 @@
(green "#005555")
(lightgreen "darkgreen")
(yellow "lightyellow"))
- (:face-size 9)
- ;; (:face-family "DejaVu Sans Mono")
- (:face-family "Hack")
(:bold-weight 'semibold)
(:palette (fg "black")
(bg "white")
@@ -102,6 +99,8 @@
(magit-diff-hunk-heading-highlight (c nil hl) it bf)
(message-header-subject (p warning) nbf)
(mode-line (c "grey20") :box (:line-width 1 :color "grey80"))
+ (mode-line-active (c "grey20")
+ :box (:line-width 1 :color "grey80"))
(mode-line-inactive
(c "grey40" bg-light) :box (:line-width 1 :color "grey80"))
(mode-line-buffer-id (~ default) (c nil nil) nit)
diff --git a/lib/themes/jao-themes.el b/lib/themes/jao-themes.el
index b1aa265..d05583a 100644
--- a/lib/themes/jao-themes.el
+++ b/lib/themes/jao-themes.el
@@ -21,8 +21,14 @@
(require 'ansi-color)
;;; palette
-(defvar jao-themes-default-face "DejaVu Sans Mono-9")
-(defvar jao-themes--face-family "DejaVu Sans Mono")
+(defvar jao-themes-default-face nil)
+(defvar jao-themes-default-family "Hack")
+(defvar jao-themes-default-variable-pitch-size 9)
+(defvar jao-themes-default-variable-pitch-family "Hack")
+(defvar jao-themes-default-size 9)
+(defvar jao-themes--face-family jao-themes-default-face)
+(defvar jao-themes--variable-pitch-family nil)
+(defvar jao-themes--variable-pitch-height nil)
(defvar jao-themes--fg "black")
(defvar jao-themes--bg "white")
(defvar jao-themes--box "grey75")
@@ -314,7 +320,7 @@
(ansi-color-green (c "darkseagreen4" "darkseagreen4"))
(ansi-color-magenta (c "lightpink3" "lightpink3"))
(ansi-color-yellow (c "lightgoldenrod3" "lightgoldenrod3"))
- (avy-lead-face (c "red" "grey90") bf :height 1.2)
+ (avy-lead-face (c "red" "grey90") bf :height 1.0)
(avy-lead-face-0 (~ avy-lead-face) bf)
(avy-lead-face-1 (~ avy-lead-face)))
`((bbdb-company)
@@ -597,7 +603,10 @@
(font-lock-type-face (p type))
(font-lock-variable-name-face (p variable-name))
(font-lock-warning-face (p warning))
+ (forge-pullreq-merged (p dimm))
(forge-pullreq-open (c nil nil))
+ (forge-pullreq-rejected (~ forge-pullreq-merged) st)
+ (forge-topic-pending (c nil nil))
(forge-topic-label bx)
(fringe (p dimm))
(fuel-font-lock-debug-error (p error) nul)
@@ -1106,7 +1115,7 @@
(twittering-uri-face (~ link))
(twittering-username-face (p f01)))
`((underline ul))
- `((variable-pitch :family ,jao-themes--face-family)
+ `((variable-pitch :family ,jao-themes--variable-pitch-family)
(variable-pitch-text (~ variable-pitch))
(vertical-border (c ,jao-themes--box nil) :inherit default)
(vertico-current (p hilite))
@@ -1225,21 +1234,32 @@
(let ((palette (cdr (assoc :palette args)))
(x-faces (cdr (assoc :x-faces args)))
(x-colors (cdr (assoc :x-colors args)))
- (family (cadr (assoc :face-family args)))
- (size (or (cadr (assoc :face-size args)) 9))
+ (family (or (cadr (assoc :face-family args))
+ jao-themes-default-family))
+ (size (or (cadr (assoc :face-size args))
+ jao-themes-default-size))
+ (vpitch (or (cadr (assoc :variable-pitch-family args))
+ jao-themes-default-variable-pitch-family))
+ (vsize (or (cadr (assoc :variable-pitch-size args))
+ jao-themes-default-variable-pitch-size))
(bw (or (cadr (assoc :bold-weight args)) jao-themes--bold-weight)))
`(progn
(custom-make-theme-feature ',name)
(deftheme ,name)
(custom-theme-set-variables ',name
'(jao-themes-default-face
- (format "%s-%s" ,family ,size))
+ ,(format "%s-%s" family size))
'(jao-themes--face-family ,family)
+ '(jao-themes--variable-pitch-family
+ ,vpitch)
+ '(jao-themes--variable-pitch-height
+ ,(* 10 vsize))
'(jao-themes--bold-weight ,bw))
(let ((*jao-themes--color-names* ',(cdr (assoc :names args)))
(jao-themes--face-family ,family))
(let* ,(jao-themes--let-palette palette)
(jao-themes--set-fbg 'x)
+ (jao-themes--set-fbg 'ns)
(jao-themes--set-fbg 'pgtk)
(let* ((xfaces (jao-themes--make-faces ',x-faces ',x-colors))
(tx-faces (jao-themes--extract-faces xfaces xfaces)))