diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/doc/jao-doc-session.el | 29 | ||||
| -rw-r--r-- | lib/doc/jao-mac.el | 228 | ||||
| -rw-r--r-- | lib/doc/jao-org-focus.el | 117 | ||||
| -rw-r--r-- | lib/doc/jao-org-links.el | 26 | ||||
| -rw-r--r-- | lib/doc/jao-org-notes.el | 33 | ||||
| -rw-r--r-- | lib/doc/jao-pdf.el | 84 | ||||
| -rw-r--r-- | lib/eos/jao-afio.el | 25 | ||||
| -rw-r--r-- | lib/eos/jao-dirmon.el | 18 | ||||
| -rw-r--r-- | lib/eos/jao-minibuffer.el | 61 | ||||
| -rw-r--r-- | lib/eos/jao-mode-line.el | 23 | ||||
| -rw-r--r-- | lib/eos/jao-notify.el | 31 | ||||
| -rw-r--r-- | lib/eos/jao-r2e.el | 228 | ||||
| -rw-r--r-- | lib/jao-recoll.el | 76 | ||||
| -rw-r--r-- | lib/media/jao-mpc.el | 45 | ||||
| -rw-r--r-- | lib/media/jao-mpris.el | 32 | ||||
| -rw-r--r-- | lib/media/jao-random-album.el | 12 | ||||
| -rw-r--r-- | lib/net/jao-eww-session.el | 19 | ||||
| -rw-r--r-- | lib/net/jao-notmuch-gnus.el | 270 | ||||
| -rw-r--r-- | lib/net/jao-notmuch.el | 72 | ||||
| -rw-r--r-- | lib/net/jao-url.el | 36 | ||||
| -rw-r--r-- | lib/net/randomsig.el | 9 | ||||
| -rw-r--r-- | lib/prog/jao-clojure.el | 191 | ||||
| -rw-r--r-- | lib/prog/jao-compilation.el | 4 | ||||
| -rw-r--r-- | lib/themes/jao-light-theme.el | 24 | ||||
| -rw-r--r-- | lib/themes/jao-themes.el | 40 |
25 files changed, 1544 insertions, 189 deletions
diff --git a/lib/doc/jao-doc-session.el b/lib/doc/jao-doc-session.el index 877a8cb..df7e994 100644 --- a/lib/doc/jao-doc-session.el +++ b/lib/doc/jao-doc-session.el @@ -1,6 +1,6 @@ ;;; jao-doc-session.el --- persistent document sessions -*- lexical-binding: t; -*- -;; Copyright (C) 2022, 2024 jao +;; Copyright (C) 2022, 2024, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: docs @@ -20,15 +20,18 @@ ;;; Code: -(persist-defvar jao-doc-session nil "Documents session") +(define-multisession-variable jao-doc--session nil) -(defvar-local jao-doc-session--is-doc nil) +(defun jao-doc-session () (multisession-value jao-doc--session)) + +(defvar-local jao-doc-session-is-doc nil + "Locally marks a buffer as belonging to a session. + +See also `jao-doc-session-mark'.") (defun jao-doc-session-is-doc (&optional buffer) "Check whether the given or current buffer belong to the doc session." - (buffer-local-value 'jao-doc-session--is-doc (or buffer (current-buffer)))) - -(defun jao-doc-session (&optional file) jao-doc-session) + (buffer-local-value 'jao-doc-session-is-doc (or buffer (current-buffer)))) (defun jao-doc-session-save (&optional skip-current force) "Traverse all current buffers and update the value of `jao-doc-session'." @@ -36,24 +39,24 @@ (let ((docs '()) (cb (and skip-current (current-buffer)))) (dolist (b (buffer-list)) - (when-let (fs (and (not (eq cb b)) (jao-doc-session-is-doc b))) + (when-let* ((fs (and (not (eq cb b)) (jao-doc-session-is-doc b))) + (fs (if (listp fs) fs (list (buffer-file-name b))))) (dolist (f fs) (add-to-list 'docs f)))) (when (or force (> (length docs) 0)) - (setq jao-doc-session docs)))) + (setf (multisession-value jao-doc--session) docs)))) (defun jao-doc-session-mark (&optional path) "Mark the current buffer's file, or PATH, as persistent across sessions." - (unless (listp jao-doc-session--is-doc) - (setq jao-doc-session--is-doc (ensure-list jao-doc-session--is-doc))) - (cl-pushnew (or path (buffer-file-name)) jao-doc-session--is-doc) + (unless (listp jao-doc-session-is-doc) + (setq jao-doc-session-is-doc (ensure-list jao-doc-session-is-doc))) + (cl-pushnew (or path (buffer-file-name)) jao-doc-session-is-doc) (jao-doc-session-save)) (defun jao-doc-session--maybe-save () (when (jao-doc-session-is-doc) (jao-doc-session-save t))) -(defvar jao-doc-session-inhibit-save nil) - (add-hook 'kill-buffer-hook #'jao-doc-session--maybe-save) +(add-hook 'kill-emacs-hook #'jao-doc-session-save) (provide 'jao-doc-session) ;;; jao-doc-session.el ends here diff --git a/lib/doc/jao-mac.el b/lib/doc/jao-mac.el new file mode 100644 index 0000000..ad11ea2 --- /dev/null +++ b/lib/doc/jao-mac.el @@ -0,0 +1,228 @@ +;;; jao-mac.el --- Running applescript. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: lisp + +;; 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-shell) + +;;; applescript +(defun jao-mac-applescript-prepare (&rest lines) + (let ((script (mapconcat 'identity lines "\r")) + (start)) + (while (string-match "\n" script) + (setq script (replace-match "\r" t t script))) + (while (string-match "'" script start) + (setq start (+ 2 (match-beginning 0)) + script (replace-match "\\'" t t script))) + script)) + +(defun jao-mac-run-applescript (script) + (string-trim (shell-command-to-string (format "osascript -e '%s'" script)))) + +(defun jao-mac-run-applescript* (&rest lines) + (jao-mac-run-applescript (apply #'jao-mac-applescript-prepare lines))) + +(defun jao-mac-tell-app (app &rest script-lines) + (let* ((app-id (string-split app)) + (id (if (> (length app-id) 1) (car app-id) "")) + (app (if (> (length app-id) 1) (cadr app-id) (car app-id))) + (pre (list (format "tell application %s %S" id app))) + (post '("end tell\n"))) + (apply #'jao-mac-run-applescript* (append pre script-lines post)))) + +;;; open + +(defun jao-mac-open (thing &rest args) + "Invoke open after formatting thing with args, using `format'" + (jao-shell-exec (format "open %s" (apply #'format thing args)))) + +(defun jao-mac-open-in-skim (&optional file page height) + (interactive) + (let* ((file (if file (expand-file-name file) (buffer-file-name))) + (page (or page (and (derived-mode-p 'doc-view-mode) + (doc-view-current-page))))) + (jao-mac-open "skim://%s%s" file (if page (format "#page=%s" page) "")))) + +;; https://alvinalexander.com/macos/applescript-how-to-open-pdf-file-in-preview-go-to-page/ +;; This will work as long as Preview is the default app for the file at hand. +(defun jao-mac-open-in-preview (&optional file page height) + (interactive) + (let ((file (if file (expand-file-name file) (buffer-file-name))) + (page (or page (and (derived-mode-p 'doc-view-doc) + (doc-view-current-page))))) + (jao-mac-run-applescript* + (format "tell application id \"com.apple.Preview\" to open (POSIX file %S)\r\r" + (file-truename file)) + "delay 1" + "tell application \"System Events\"" + "keystroke \"g\" using {option down, command down}" + (format "keystroke %s" (or page 1)) + "delay 0.1\rkeystroke return\rend tell"))) + +;;; notifications + +(defun jao-mac-notify (title subtitle msg) + (jao-mac-run-applescript* + (format "display notification %S with title %S subtitle %S" + msg title subtitle))) + +;;; Skim +(defvar jao-skim--current-file-script + (jao-mac-applescript-prepare + "tell application \"Skim\"" + " try" + " set theD to front document" + " set theP to (path of theD)" + " set thePg to (get index of current page of theD)" + " return (theP & \"::\" & thePg)" + " on error" + " return \"\"" + " end try" + "end tell")) + +(defun jao-skim-current-doc () + "Returns a list of path and page number for the current Skim doc." + (when-let* ((p (jao-mac-run-applescript jao-skim--current-file-script)) + (p (and (not (string-blank-p p)) p))) + (let ((ps (split-string p "::"))) + (list (car ps) (string-to-number (cadr ps)))))) + +(defun jao-skim-open-current-doc () + (interactive) + (when-let* ((ps (jao-skim-current-doc))) + (apply 'jao-open-doc ps))) + +(defvar jao-skim--current-page-text + (jao-mac-applescript-prepare + "tell application \"Skim\"" + "return the text of the current page of the front document" + "end tell")) + +(defun jao-skim-page-text () + (jao-mac-run-applescript jao-skim--current-page-text)) + +(defun jao-skim-view-page-text () + (interactive) + (when-let* ((ps (jao-skim-current-doc)) + (p (car ps)) + (n (cadr ps)) + (txt (jao-skim-page-text)) + (bn (format "*%s - %s - txt*" p n))) + (with-current-buffer (get-buffer-create bn) + (delete-region (point-min) (point-max)) + (insert txt) + (pop-to-buffer (current-buffer))))) + +;;; NetNewsWire + +(defvar jao-nnw--current-article-script + (jao-mac-applescript-prepare + "tell application \"NetNewsWire\"" + "try" + "return (the url of the current article)" + "on error" + "return \"\"" + "end try" + "end tell")) + +(defun jao-nnw-current-article () + "The URL of the current article in NetNewsWire" + (jao-mac-run-applescript jao-nnw--current-article-script)) + +(defun jao-nnw-browse-current-article () + "Browse the URL of the current NNW article." + (interactive) + (if-let* ((url (jao-nnw-current-article))) + (unless (string-empty-p url) + (browse-url url)) + (message "No article selected in NetNewsWire"))) + +(defvar jao-nnw--label-cmd + "lsappinfo info -app NetNewsWire -only StatusLabel") + +(defun jao-nnw-unread-count () + "A very hacky, yet efficient, way of getting NNW's badge." + (let ((s (shell-command-to-string jao-nnw--label-cmd))) + (when (string-match ".*=\"\\([0-9]+\\)\" ." s) + (string-to-number (match-string 1 s))))) + +(defun jao-mac-open-nnw () + (interactive) + (jao-mac-open "-a NetNewsWire")) + +;;; Safari +(defun jao-safari-current-url () + (jao-mac-tell-app "Safari" "return URL of current tab of window 1")) + +(defun jao-safari-browse-current () + "Browse the URL of the current Safari topmost document." + (interactive) + (browse-url (jao-safari-current-url))) + +;;; Firefox +(defvar jao-ffox--current-url-script + (jao-mac-applescript-prepare + "tell application \"Firefox\"" + " activate" + " delay 0.15" + " tell application \"System Events\"" + " keystroke \"l\" using command down" + " delay 0.20" + " keystroke \"c\" using command down" + " end tell" + " delay 0.5" + "end tell" + "return the clipboard")) + +(defun jao-firefox-current-url () + (let ((res (jao-mac-run-applescript jao-ffox--current-url-script))) + (jao-mac-run-applescript "tell application \"Emacs\" to activate") + res)) + +(defun jao-firefox-open () + (interactive) + (jao-mac-open "-a Firefox")) + +;;; DevonThink + +(defun jao-devon-tell (&rest script-lines) + (apply #'jao-mac-tell-app "id DNtp" script-lines )) + +(defun jao-devon-find-url (file) + (jao-devon-tell + "repeat with db in databases" + (format "set res to lookup records with path %S in db" + (file-truename file)) + "if res /= {} then return the reference URL of (item 1 of res)" + "end repeat" + "return \"\"")) + +(defun jao-devon-show-search (s) + (jao-devon-tell (format "show search %S" s) "activate")) + +(defun jao-devon-open (file &optional page height) + (let ((url (jao-devon-find-url file))) + (if (string-empty-p (or url "")) + (let ((jao-pdf-open-in-emacs t)) + (jao-find-or-open file page height)) + (let* ((p (if page (format "?page=%s" (- page 1)) "")) + (u (format "%s%s" url p))) + (jao-mac-open "%s%s" url p))))) + +(provide 'jao-mac) +;;; jao-mac.el ends here diff --git a/lib/doc/jao-org-focus.el b/lib/doc/jao-org-focus.el new file mode 100644 index 0000000..e9d6ed2 --- /dev/null +++ b/lib/doc/jao-org-focus.el @@ -0,0 +1,117 @@ +;;; jao-org-focus.el --- focusing on org subtrees -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: docs + +;; 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 'org) + +(defvar-local jao-org-focus--parent nil) +(defvar-local jao-org-focus--section nil) + +;;; focus on subtree +(defun jao-org-focus () + "Pop creatingly to an indirect buffer focused on the encloing subtree. + +When invoked on an indirect buffer, pops back to its base." + (interactive) + (if-let* ((b (get-buffer (or jao-org-focus--parent "")))) + (pop-to-buffer b) + (when-let* ((elem (org-element-at-point)) + (header (if (eq 'headline (org-element-type elem)) + elem + (org-previous-visible-heading 1) + (org-element-at-point))) + (title (org-element-property :title header)) + (parent (buffer-name)) + (bname (format "%s [%s]" title parent))) + (if-let* ((b (get-buffer bname))) + (pop-to-buffer b) + (clone-indirect-buffer bname t) + (org-focus-mode -1) + (org-focus-child-mode) + (setq jao-org-focus--parent parent + jao-org-focus--section title) + (org-narrow-to-subtree) + (show-subtree))))) + +(defun jao-org-focus-redisplay () + "Redisplay a focused buffer. + +Useful when its parent has been reorganised and the narrowing is out of +sync." + (interactive) + (when-let* ((title jao-org-focus--section)) + (widen) + (goto-char (point-min)) + (when (re-search-forward (format "\\*+ %s" title) nil t) + (org-narrow-to-subtree) + (goto-char (point-min))))) + +(defun jao-org-focus-redisplay-children () + "Find focused children and redisplay them." + (interactive) + (dolist (b (jao-org-focus-list)) + (with-current-buffer b (jao-org-focus-redisplay)))) + +(defun jao-org-focus-list (&optional any-parent) + "List of buffers that are focusing on a subtree of this one or its parent." + (let ((n (or jao-org-focus--parent (buffer-name)))) + (seq-filter (lambda (b) + (let ((p (buffer-local-value 'jao-org-focus--parent b))) + (and p (or any-parent (string= n p))))) + (buffer-list)))) + +(defvar jao-org-focus--focused-history nil) + +(defun jao-org-focus-switch (arg) + "Read with completion a focused child and pop to it. + +With arg, offer to switch to all children, regardless of their parent." + (interactive "P") + (let ((fl (mapcar 'buffer-name (jao-org-focus-list arg)))) + (unless fl (error "No focused children")) + (pop-to-buffer + (completing-read "Focused child: " fl + nil t nil 'jao-org-focus--focused-history)))) + +(defvar jao-org-focus-consult-buffer-source + `(:name "Focus buffers" + :category jao-org-focus-buffers + :action switch-to-buffer + :hidden t + :narrow ,(cons ?o "focus") + :history jao-org-focus--focused-history + :items ,(lambda () (mapcar 'buffer-name (jao-org-focus-list t))))) + +(define-minor-mode org-focus-mode + "A mode where keeping track of focused children is on by default." + :lighter " â—Ž" + :keymap '(("\C-cl" . jao-org-focus-switch) + ("\C-cR" . jao-org-focus-redisplay) + ("\C-co" . jao-org-focus)) + (if org-focus-mode + (add-hook 'after-save-hook #'jao-org-focus-redisplay-children nil t) + (remove-hook 'after-save-hook #'jao-org-focus-redisplay-children t))) + +(define-minor-mode org-focus-child-mode + "A mode for the children of a focused org buffer." + :lighter " â—‰" + :keymap org-focus-mode-map) + +(provide 'jao-org-focus) +;;; jao-org-focus.el ends here diff --git a/lib/doc/jao-org-links.el b/lib/doc/jao-org-links.el index 88c0561..95f2d67 100644 --- a/lib/doc/jao-org-links.el +++ b/lib/doc/jao-org-links.el @@ -17,8 +17,9 @@ (funcall (or jao-org-open-pdf-fun #'jao-org--default-open) path page height)) (defun jao-org-links--open-pdf (link) - "Open LINK in pdf-view-mode." - (cond ((string-match "\\(.*\\)::\\([0-9]*\\)\\+\\+\\([[0-9]\\.*[0-9]*\\)" link) + "Open LINK using `jaor-org-open-pdf-fn'." + (cond ((string-match "\\(.*\\)::\\([0-9]*\\)\\+\\+\\([[0-9]\\.*[0-9]*\\)" + link) (let* ((path (match-string 1 link)) (page (string-to-number (match-string 2 link))) (height (string-to-number (match-string 3 link)))) @@ -101,21 +102,28 @@ (insert "\n#+startup: latexpreview\n\n")) ;;;###autoload -(defun jao-org-pdf-goto-org (arg) +(defun jao-org-pdf-goto-org (arg &optional file-name) (interactive "P") - (when (jao-pdf-is-pdf-file buffer-file-name) - (let* ((file (jao-org-notes-find-for-pdf)) - (new (not (file-exists-p file))) - (title (jao-pdf-title))) - (when (or arg new) (org-store-link nil t)) + (when (jao-pdf-is-pdf-file (or file-name buffer-file-name)) + (let* ((file (jao-org-notes-find-for-pdf file-name)) + (new (not (file-exists-p file)))) + (if (and (not file-name) (or arg new)) + (org-store-link nil t) + (when-let* ((fboundp 'jao-skim-current-doc) + (lnk (jao-pdf-skim-org-link nil))) + (kill-new lnk))) (find-file-other-window file) (when new - (jao-org-insert-doc-skeleton title) + (jao-org-insert-doc-skeleton (jao-pdf-title file-name)) (org-insert-link))))) ;;;###autoload (defun jao-org-pdf-goto-org* () (interactive) (jao-org-pdf-goto-org t)) +(defun jao-org-org-to-pdf-file () + (expand-file-name (concat "doc/" (file-name-base buffer-file-name) ".pdf") + (file-name-directory jao-org-notes-dir))) + ;;;###autoload (defun jao-org-goto-pdf () (interactive) 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/doc/jao-pdf.el b/lib/doc/jao-pdf.el index 1ee74bc..162cd9a 100644 --- a/lib/doc/jao-pdf.el +++ b/lib/doc/jao-pdf.el @@ -1,6 +1,6 @@ ;;; jao-pdf.el --- utilities for pdf files -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: docs @@ -96,5 +96,87 @@ (defun jao-pdf-zathura-org-link (title) (jao-pdf--zathura-link (jao-pdf-zathura-file-info title))) +(defun jao-zathura-open (file page) + (let ((id (jao-x11-search-window (jao-pdf-zathura-title-rx file)))) + (if (string-blank-p id) + (progn + (when jao-xmonad-enabled (jao-x11-goto-ws 2)) + (jao-shell-exec (jao-pdf-zathura-open-cmd file page))) + (let* ((page (if page (format " && xdotool type %dg" page) "")) + (cmd (format "xdotool windowactivate %s%s" id page))) + (jao-shell-exec cmd t))))) + +;;; Mac + +(when (eq system-type 'darwin) + (require 'jao-mac) + (defun jao-pdf-skim-org-link (title) + (when-let* ((fp (jao-skim-current-doc)) + (file (file-name-nondirectory (car fp))) + (page (cadr fp)) + (lnk (format "doc:%s::%s" file page))) + (org-make-link-string lnk title))) + + (defun jao-pdf-insert-skim-org-link () + (interactive) + (if-let* ((title (read-string "Title: ")) + (lnk (jao-pdf-skim-org-link title))) + (insert lnk) + (user-error "Skim is not viewing any docs!")))) + +;;; Open doc functions +(defvar jao-pdf-open-in-emacs t) + +(defun jao-find-or-open (file &optional page height) + (cond ((and jao-pdf-open-in-emacs window-system) + (let* ((buffs (buffer-list)) + (b (catch 'done + (while buffs + (when (string-equal (buffer-file-name (car buffs)) file) + (throw 'done (car buffs))) + (setq buffs (cdr buffs)))))) + (jao-afio-goto-docs) + (if b (pop-to-buffer b) (find-file file)) + (when page (jao-doc-view-goto-page page height)))) + (jao-river-enabled (jao-river-open-with-zathura file page)) + (jao-sway-enabled (jao-sway-open-with-zathura file page)) + ((eq system-type 'darwin) (jao-mac-open-in-skim file page)) + (t (jao-zathura-open file page)))) + +(defun jao-open-doc (&optional file page height) + (interactive) + (when-let (file (or file + (read-file-name "Document: " + (concat jao-org-dir "/doc/")))) + (funcall jao-open-doc-fun file page height))) + +(defun jao-select-pdf () + (interactive) + (jao-buffer-same-mode '(pdf-view-mode doc-view-mode org-mode) + #'jao-afio-goto-docs)) + +(defun jao-open-with-zathura () + (interactive) + (when-let (f buffer-file-name) + (let ((p (jao-doc-view-current-page))) + (cond (jao-river-enabled (jao-river-open-with-zathura f p)) + (jao-sway-enabled (jao-sway-open-with-zathura f p)) + (t (jao-zathura-open f p)))))) + +;;; doc:// links for browse-url + +(defun jao-open-doc-url (url &rest _) + (when (string-match "doc://\\([^?]+\\)\\(\\?.*\\)?" url) + (let ((file (match-string 1 url)) + (page (when-let* ((qs (match-string 2 url)) + (long (> (length qs) 1)) + (ps (url-parse-query-string (substring qs 1))) + (pn (cadr (assoc "page" ps)))) + (string-to-number pn)))) + (jao-open-doc (expand-file-name (concat "doc/" file) jao-org-dir) page)))) + +(add-to-list 'browse-url-handlers (cons "^doc://.+" 'jao-open-doc-url)) + + (provide 'jao-pdf) ;;; jao-pdf.el ends here diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el index b588989..99152b0 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 @@ -41,7 +41,7 @@ (interactive) (jao-afio--current-config ?c) (if jao-afio-use-frames - (set-frame-name "W1") + (set-frame-name (jao-afio-frame-name ?c)) (window-configuration-to-register ?c))) (defun jao-afio--check-frame () @@ -71,12 +71,11 @@ ;;;###autoload (defun jao-afio-open-pdf-session (&optional docs) (interactive) - (let ((jao-doc-session-inhibit-save t)) - (dolist (doc (or docs (jao-doc-session))) - (when (and doc (file-exists-p doc)) - (if (jao-pdf-is-pdf-file doc) (jao-open-doc doc) (find-file doc)) - (other-window 1))) - (other-window 1))) + (dolist (doc (or docs (jao-doc-session))) + (when (and (stringp doc) (file-exists-p doc)) + (if (jao-pdf-is-pdf-file doc) (jao-open-doc doc) (find-file doc)) + (other-window 1))) + (other-window 1)) (defun jao-afio-open-doc () (interactive) @@ -122,10 +121,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)) @@ -196,15 +195,15 @@ (select-frame-set-input-focus (or f (make-frame))) (when (setq reset (or reset (not f))) (set-frame-name - (format "W%s" (or (jao-afio-frame-no next) next))))) + (format "%s" (or (jao-afio-frame-name next) next))))) (window-configuration-to-register (jao-afio--current-config)) (when (and (not reset) (get-register next)) (ignore-errors (jump-to-register next))) (setq reset (or reset (not (get-register next))))) (jao-afio--current-config next) (unless (eq current next) (setq jao-afio--previous-config current)) - (when reset (jao-afio-reset)) - (run-hooks 'jao-afio-switch-hook))))) + (when reset (jao-afio-reset))) + (run-hooks 'jao-afio-switch-hook)))) (defun jao-afio-goto-main (&optional reset) (interactive "P") @@ -228,7 +227,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..629ce8d 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 @@ -34,25 +34,27 @@ (defvar jao-minibuffer-active-buffer-line-color "azure4") (defvar jao-minibuffer-inactive-buffer-line-color "grey25") (defvar jao-minibuffer-inhibit nil) +(defvar jao-minibuffer-info-face 'default) +(defvar jao-minibuffer-info-face-alt 'default) (defconst jao-minibuffer--name " *Minibuf-0*") (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) (jao-minibuffer-maximized-frames-p (frame-width)) (t (min (frame-width) (window-width (minibuffer-window)))))) -(defun jao-minibuffer--format-info (&optional info) - (let* ((info (or info jao-minibuffer-info)) - (info (if jao-minibuffer-align-right info (reverse info)))) - (mapconcat #'string-trim - (seq-remove #'string-blank-p (mapcar 'format-mode-line info)) - " "))) +(defun jao-minibuffer--format-info (&optional info alt-p) + (let* ((face (if alt-p jao-minibuffer-info-face-alt jao-minibuffer-info-face)) + (info (or info jao-minibuffer-info)) + (info (if jao-minibuffer-align-right info (reverse info))) + (info (seq-remove #'string-blank-p (mapcar 'format-mode-line info)))) + (propertize (mapconcat #'string-trim info " ") 'face face))) (defun jao-minibuffer--aligned (w) (let* ((msg (jao-minibuffer--format-info)) @@ -79,7 +81,8 @@ (defun jao-minibuffer--format-msg (msg) (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n" t))) - (msgs (cl-remove-if (lambda (s) (get-text-property 0 'invisible s)) msgs)) + (msgs + (seq-remove (lambda (s) (get-text-property 0 'invisible s)) msgs)) (prefix (jao-minibuffer--prefix msgs)) (msg (or (car (last msgs)) "")) (w (string-width msg))) @@ -91,14 +94,11 @@ (when jao-minibuffer-mode (or (and (string= jao-minibuffer--name (or (buffer-name) "")) msg) jao-minibuffer-inhibit - (let* ((info (and jao-minibuffer-msg-info - (jao-minibuffer--format-info jao-minibuffer-msg-info))) - (info (or (and info msg (propertize info 'face 'jao-themes-dimm)) - info)) - (sep (if msg " - " "")) - (pref (when info - (let ((len (+ (length info) (length sep)))) - (format (format "\n%%%ds" len) "")))) + (and (not jao-minibuffer-msg-info) msg) + (let* ((info (jao-minibuffer--format-info jao-minibuffer-msg-info t)) + (sep (if (string-blank-p (or msg "")) "" " - ")) + (pref (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) msg)) @@ -141,10 +141,10 @@ :global t :lighter "" :group 'jao (if jao-minibuffer-mode (progn ;; (advice-add 'select-window :after #'jao-minibuffer-refresh) - (advice-add 'select-window :after #'jao-minibuffer--adjust-alignment) - (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh) - (setq clear-message-function #'jao-minibuffer--clear-message) - (jao-minibuffer-refresh)) + (advice-add 'select-window :after #'jao-minibuffer--adjust-alignment) + (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh) + (setq clear-message-function #'jao-minibuffer--clear-message) + (jao-minibuffer-refresh)) (advice-remove 'select-window #'jao-minibuffer-refresh) (advice-remove 'force-mode-line-update #'jao-minibuffer-refresh) (setq clear-message-function nil) @@ -164,5 +164,24 @@ (not jao-minibuffer-adaptive-alignment)) (jao-minibuffer-refresh)) +(define-minor-mode jao-minibuffer-mode-line-mode + "Show info in mode line instead of minibuffer" + :global t :lighter "" :group 'jao + (let ((e '(" " (:eval jao-minibuffer-info)))) + (if jao-minibuffer-mode-line-mode + (add-to-list 'global-mode-string e) + (setq global-mode-string (delete e global-mode-string))))) + +(defvar jao-minibuffer--title-format nil) + +(define-minor-mode jao-minibuffer-frame-title-mode + "Show info in frame title instead of minibuffer" + :global t :lighter "" :group 'jao + (when (not jao-minibuffer--title-format) + (setq jao-minibuffer--title-format frame-title-format)) + (if jao-minibuffer-frame-title-mode + (setq frame-title-format '("emacs - " (:eval jao-minibuffer-info))) + (setq frame-title-format jao-minibuffer--title-format))) + (provide 'jao-minibuffer) ;;; jao-minibuffer.el ends here diff --git a/lib/eos/jao-mode-line.el b/lib/eos/jao-mode-line.el index e4f64c0..d3388e4 100644 --- a/lib/eos/jao-mode-line.el +++ b/lib/eos/jao-mode-line.el @@ -1,6 +1,6 @@ ;;; jao-mode-line.el --- mode-line info -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -31,7 +31,7 @@ ;;;; mode line toggle (defun jao-mode-line--face-height (face &optional all) (let* ((h (face-attribute face :height (window-frame))) - (nh (if (eq 'unspecified h) 1 'unspecified))) + (nh (if (eq 'unspecified h) 10 'unspecified))) (set-face-attribute face (when (not all) (window-frame)) :height nh))) (defun jao-mode-line--set-inactive-face (x frame) @@ -41,7 +41,7 @@ ;;;###autoload (defun jao-mode-line-toggle (&optional all) (interactive "P") - (jao-mode-line--face-height 'mode-line all)) + (jao-mode-line--face-height 'mode-line-active all)) ;;;###autoload (defun jao-mode-line-toggle-inactive (&optional all) @@ -62,7 +62,7 @@ ;;;###autoload (defun jao-mode-line-hide-inactive (frame) - (jao-mode-line--set-inactive-face 1 frame)) + (jao-mode-line--set-inactive-face 10 frame)) ;;;###autoload (defun jao-mode-line-show-inactive (frame) @@ -85,8 +85,6 @@ 'gnus-article-mode 'gnus-summary-mode) mode-line-buffer-identification) - ;; ((derived-mode-p 'circe-channel-mode) - ;; (format "%s [%d]" (buffer-name) (length (circe-channel-nicks)))) ((not (null eww-data)) (or (plist-get eww-data :title) "No title")) (t "%b")))) @@ -108,7 +106,7 @@ ;;;; mode line in minibuffer -(defvar jao-mode-line--old-format nil) +(defvar jao-mode-line--old-format mode-line-format) (defvar jao-mode-line--face nil) (defvar jao-mode-line--inactive-face nil) (defvar jao-mode-line--props @@ -127,15 +125,18 @@ (if inactive jao-mode-line--inactive-face jao-mode-line--face))) (defun jao-mode-line-adjust-faces () - (let ((bg (and (display-graphic-p) (frame-parameter nil 'background-color))) + (interactive) + (let ((bg (and (display-graphic-p) + (frame-parameter nil 'background-color))) (ol (and (display-graphic-p) jao-minibuffer-active-buffer-line-color)) - (ul (and (display-graphic-p) jao-minibuffer-inactive-buffer-line-color))) + (ul (and (display-graphic-p) + jao-minibuffer-inactive-buffer-line-color))) (jao-mode-line--extract-face nil) (jao-mode-line--extract-face t) - (set-face-attribute 'mode-line nil :box nil :height 1 + (set-face-attribute 'mode-line-active nil :box nil :height 10 :background bg :foreground bg :overline ol :underline ul :extend t) - (set-face-attribute 'mode-line-inactive nil :box nil :height 1 + (set-face-attribute 'mode-line-inactive nil :box nil :height 10 :background bg :foreground bg ;; :overline bg :underline ul :extend t))) diff --git a/lib/eos/jao-notify.el b/lib/eos/jao-notify.el index 623b8cc..8389b3a 100644 --- a/lib/eos/jao-notify.el +++ b/lib/eos/jao-notify.el @@ -1,6 +1,6 @@ ;; jao-notify.el -- Interacting with notification daemon -;; Copyright (c) 2017, 2019, 2020, 2021, 2024 Jose Antonio Ortega Ruiz +;; Copyright (c) 2017, 2019, 2020, 2021, 2024, 2025 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sun Jan 08, 2017 20:24 @@ -17,21 +17,30 @@ (defvar jao-notify-audio-icon (jao-data-file "music-player-icon.png")) (declare-function notifications-notify "notifications") +(declare-function alert "alert") +(declare-function jao-mac-notify "jao-mac") ;; "/usr/share/icons/Papirus/64x64/mimetypes/audio-x-generic.svg" ;; "/usr/share/icons/Tango/scalable/mimetypes/audio-x-generic.svg" -(defun jao-notify (msg &optional title icon) +(defun jao-notify (msg &optional title icon subtitle) (let ((title (when (and title (not (string-blank-p title))) title))) - (if jao-notify-use-messages - (message "%s%s%s" (or title "") (if title ": " "") (or msg "")) - (let* ((args `(:timeout ,jao-notify-timeout)) - (args (append args - (if title `(:title ,title :body ,msg) `(:title ,msg)))) - (args (if (and (stringp icon) (file-exists-p icon)) - (append args `(:app-icon ,(format "%s" icon))) - args))) - (apply 'notifications-notify args))))) + (cond ((eq jao-notify-use-messages t) + (message "%s%s%s" (or title "") (if title ": " "") (or msg ""))) + ((eq jao-notify-use-messages 'notification) + (let* ((args `(:timeout ,jao-notify-timeout)) + (args (append args + (if title + `(:title ,title :body ,msg) + `(:title ,msg)))) + (args (if (and (stringp icon) (file-exists-p icon)) + (append args `(:app-icon ,(format "%s" icon))) + args))) + (apply 'notifications-notify args))) + ((eq jao-notify-use-messages 'alert) + (alert msg :title title :icon icon :never-persist t)) + ((eq jao-notify-use-messages 'mac) + (jao-mac-notify title subtitle msg))))) (provide 'jao-notify) diff --git a/lib/eos/jao-r2e.el b/lib/eos/jao-r2e.el new file mode 100644 index 0000000..09b4504 --- /dev/null +++ b/lib/eos/jao-r2e.el @@ -0,0 +1,228 @@ +;;; 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) + (define-key map [?y] 'jao-r2e-kill-url) + (define-key map [?x] 'jao-r2e-list-subscribed) + 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-list-subscribed (arg) + "Show only subscribed (unsubscribed with arg) feeds." + (interactive "P") + (jao-r2e-list) + (let ((inhibit-read-only t)) + (flush-lines (if arg ".*\\[\\*\\].*" ".*\\[ \\].*")))) + +(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-kill-url () + "Copy as kill the URL of the feed at point." + (interactive) + (let ((url (cadddr (jao-r2e--feed-at-point)))) + (if (not url) + (error "No feed at point") + (kill-new url) + (message "%s" url)))) + +(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))))) + +(define-multisession-variable jao-r2e-deleted-feeds '() + "List of rss2email feeds deleted at some point.") + +(defun jao-r2e--deleted () (multisession-value jao-r2e-deleted-feeds)) + +(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)) + (entry (cdr f))) + (when (yes-or-no-p (format "Delete feed '%s'" (car entry))) + (setf (multisession-value jao-r2e-deleted-feeds) + (cons entry (remove entry (jao-r2e--deleted)))) + (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)) + (error "No feeds recoverable at this point.")) + (let* ((entries (jao-r2e--deleted)) + (feed (completing-read "Recover feed: " entries))) + (when-let* ((ps (assoc feed entries)) + (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) + (setf (multisession-value jao-r2e-deleted-feeds) (remove ps entries))))) + +(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/jao-recoll.el b/lib/jao-recoll.el new file mode 100644 index 0000000..364dfb5 --- /dev/null +++ b/lib/jao-recoll.el @@ -0,0 +1,76 @@ +;;; jao-recoll.el --- Utilities to use recoll -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: mail, text + +;; 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: + +;; Notably, a half-backed backend for Gnus + +;;; Code: + +(require 'gnus-search) + +(defclass gnus-search-recoll (gnus-search-indexed) + ((separator :type string :initform ".") + (program :initform "recoll") + (raw-queries-p :initform t))) + +(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-recoll)) + (prog1 (and (looking-at "^file://\\(.+\\)$") (list (match-string 1) 100)) + (forward-line 1))) + +(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-recoll) + expr) + expr) + +(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-recoll) + (qstring string) + query + &optional groups) + (let* ((subdir (slot-value engine 'remove-prefix)) + (sep (slot-value engine 'separator)) + (gdirs (mapcar (lambda (g) + (let ((g (gnus-group-short-name g))) + (replace-regexp-in-string "\\." sep g))) + (or groups + (and (not (string= "" subdir)) (list subdir))))) + (dirsq (and gdirs + (concat "(" + (mapconcat (lambda (d) (format "dir:%s" d)) + gdirs " OR ") + ")"))) + (qstring (if (string-prefix-p "id:" qstring) + (replace-regexp-in-string "<\\|>" "\"" qstring) + qstring)) + (qstring (if (cdr (assoc 'thread query)) + (concat qstring " OR " + (replace-regexp-in-string "id:\"" "ref:\"" + qstring)) + qstring)) + (qstring (replace-regexp-in-string " or " " OR " qstring)) + (qstring (replace-regexp-in-string " and " " AND " qstring)) + (q (format "mime:message %s (%s)" dirsq qstring))) + ;; (message "query is: %s -- %S" q query) + `("-b" "-t" "-q" ,q))) + +(defun jao-recoll-gnus-search-engine (dir) + `(nnml "" (gnus-search-engine gnus-search-recoll (remove-prefix ,dir)))) + +(provide 'jao-recoll) +;;; jao-recoll.el ends here diff --git a/lib/media/jao-mpc.el b/lib/media/jao-mpc.el index 0f000da..5228787 100644 --- a/lib/media/jao-mpc.el +++ b/lib/media/jao-mpc.el @@ -1,6 +1,6 @@ ;;; jao-mpc.el --- Using mpc to interact with mpd -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022, 2024 jao +;; Copyright (C) 2021, 2022, 2024, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -30,6 +30,7 @@ (require 'jao-themes) (require 'jao-lyrics) (require 'jao-random-album) +(require 'jao-notify) (defconst jao-mpc--albums "*MPC Albums*") (defconst jao-mpc--playlist "*MPC Playlist*") @@ -46,11 +47,12 @@ (mapconcat (lambda (f) (format "%s:::%%%s%%" f f)) fields "\n")) (defconst jao-mpc--fields - '(artist album composer originaldate genre title track position time name)) + '(artist album composer originaldate genre title track position time name + file)) (defconst jao-mpc--stfmt (jao-mpc--fformat - '(artist album composer originaldate genre title track name))) + '(artist album composer originaldate genre title track name file))) (defconst jao-mpc--stfmtt (jao-mpc--fformat '(currenttime totaltime percenttime songpos length))) @@ -106,7 +108,8 @@ (jao--put-face (or artist "") 'jao-themes-f01) (jao--put-face (if composer (format " [%s]" composer) "") 'jao-themes-f01) - (jao--put-face (if album (format " (%s)" album) "") 'jao-themes-f11) + (jao--put-face (if album (format " (%s)" album) "") + 'jao-themes-f11) (jao--put-face tims (if times 'jao-themes-f00 'jao-themes-dimm)))) "")) @@ -131,9 +134,11 @@ (make-process :name (format "jao-mpc-idleloop (%s)" port) :buffer nil :noquery t - :command `("mpc" "-p" ,(format "%s" (or port jao-mpc-port)) - "idleloop" "player") - :filter (lambda (_p _s) (jao-mpc--set-current-str port))))) + :command + `("mpc" "-p" ,(format "%s" (or port jao-mpc-port)) + "idleloop" "player") + :filter (lambda (_p _s) + (jao-mpc--set-current-str port))))) (defvar jao-mpc--browser-port nil) @@ -157,7 +162,8 @@ (let ((a (or album (string-trim (thing-at-point 'line)))) (p (or port jao-mpc--browser-port))) (jao-mpc--cmd "clear" p) - (jao-mpc--cmd (if idp (concat "add " a) (format "findadd album \"%s\"" a)) p) + (jao-mpc--cmd (if idp (concat "add " a) (format "findadd album \"%s\"" a)) + p) (jao-mpc--cmd "play" p))) (define-key jao-mpc-albums-mode-map (kbd "n") #'next-line) @@ -190,7 +196,8 @@ (define-key jao-mpc-playlist-mode-map (kbd "n") #'next-line) (define-key jao-mpc-playlist-mode-map (kbd "p") #'previous-line) (define-key jao-mpc-playlist-mode-map (kbd "q") #'bury-buffer) -(define-key jao-mpc-playlist-mode-map (kbd ".") #'jao-mpc--playlist-goto-current) +(define-key jao-mpc-playlist-mode-map (kbd ".") + #'jao-mpc--playlist-goto-current) (define-key jao-mpc-playlist-mode-map (kbd "RET") #'jao-mpc--playlist-play) (define-key jao-mpc-playlist-mode-map (kbd "C") #'jao-mpc-clear) @@ -252,6 +259,23 @@ (message "Playing time: %s" (jao-mpc--current-timestr t))) ;;;###autoload +(defun jao-mpc-notify (&optional port) + (interactive) + (when-let* ((current (jao-mpc--current))) + (let* ((artist (or (alist-get 'artist current) "Anonymous")) + (title (or (alist-get 'title current) + (when-let* ((tl (alist-get 'file current))) + (file-name-base tl)) + "")) + (album (or (alist-get 'album current) "")) + (track (or (alist-get 'track current) "")) + (times (jao-mpc--current-timestr t current))) + (jao-notify (format "%s -- %s" artist times) + (format "%s %s" track title) + jao-notify-audio-icon + album)))) + +;;;###autoload (defun jao-mpc-add-url (url) (interactive "sURL: ") (jao-mpc--cmd (format "add %s" url))) @@ -311,8 +335,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..aa63d7c --- /dev/null +++ b/lib/net/jao-notmuch-gnus.el @@ -0,0 +1,270 @@ +;;; 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") + +(defclass gnus-search-jao-notmuch (gnus-search-notmuch) ()) + +(cl-defmethod gnus-search-indexed-search-command + ((engine gnus-search-jao-notmuch) (qstring string) query &optional groups) + (let* ((limit (alist-get 'limit query)) + (thread (alist-get 'thread query)) + (qs (cond (thread + (format "thread:\"{%s}\"" + (thread-last (string-replace "\"" "\"\"" qstring) + (string-replace "<" "") + (string-replace ">" "")))) + (groups + (let ((gs (mapconcat 'gnus-group-short-name groups "|"))) + (format "(%s) and folder:/%s/" qstring gs))) + (t qstring)))) + (with-slots (switches config-file) engine + `(,(format "--config=%s" config-file) "search" "--output=files" + ,@(unless thread '("--duplicate=1")) + ,@(when limit (list (format "--limit=%d" limit))) + ,@switches + ,qs)))) + + +(cl-defmethod gnus-search-transform-expression ((engine gnus-search-jao-notmuch) + (expr (head list))) + (message "List query: %s" expr) + (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 info 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..73f6420 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; -*- +;; 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 @@ -167,7 +167,7 @@ (jao-notmuch-goto-tree-buffer t))) (defun jao-notmuch--view-html () - "Open the text/html part of the current message using `notmuch-show-view-part'." + "Open the text/html part of current message using `notmuch-show-view-part'." (interactive) (save-excursion (goto-char @@ -316,6 +316,12 @@ (let ((undo (jao-notmuch--has-tag "deleted"))) (jao-notmuch-tree-tag-thread '("+deleted" "-new" "-unread") undo full))) +(defun jao-notmuch-tree-mark-all-read () + (interactive) + (when-let* ((q notmuch-tree-basic-query)) + (when (yes-or-no-p "Mark all messages as read? ") + (notmuch-tag q '("-new" "-unread"))))) + (defun jao-notmuch-tree-read-thread (full) (interactive "P") (jao-notmuch-tree-tag-thread '("-unread" "-new") nil full)) @@ -339,35 +345,28 @@ (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")) - -(defun jao-notmuch-mua--fcc-dirs () - (let* ((otags (notmuch-show-get-tags)) - (trove (or (seq-some (lambda (x) (and (member x otags) x)) - '("hacking" "bills" "feeds" "jao")) - "jao")) - (tags (seq-difference otags jao-notmuch-mua-reply-not-inherited)) - (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) - (fcc (concat "trove/" trove " " tagstr " -new +sent +trove")) - (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) - (append fcc-dirs `((".*" . ,fcc))))) +(defvar jao-notmuch-tags-not-inherited + '("attachment" "sent" "new" "trove" "flagged" "drivel")) + +(defvar jao-notmuch-sent-dir "sent") (defun jao-notmuch-mua--inherited-fcc () - (let* ((fn (notmuch-show-get-filename)) - (dest (and (string-match ".*/var/mail/\\(.+?\\)/.+" fn) - (match-string 1 fn))) - (tags (seq-difference (notmuch-show-get-tags) - '("attachment" "sent" "new" "flagged"))) + (let* ((tags (seq-difference (notmuch-show-get-tags) + jao-notmuch-tags-not-inherited)) (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) - (fcc (concat dest " " tagstr " -new +sent +trove")) + (fcc (concat jao-notmuch-sent-dir " " tagstr " -new +sent")) (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) (append fcc-dirs `((".*" . ,fcc))))) (defun jao-notmuch-mua-new-reply (fun &rest args) - (let ((notmuch-fcc-dirs (and (not (notmuch-show-get-header :List-Id)) - (jao-notmuch-mua--inherited-fcc)))) + (let ((notmuch-fcc-dirs (jao-notmuch-mua--inherited-fcc))) (apply fun args))) (advice-add 'notmuch-mua-new-reply :around #'jao-notmuch-mua-new-reply) @@ -384,9 +383,10 @@ (seq-sort #'jao-notmuch-cmp-tags)))) (format-spec fmt `((?s . ,(mapconcat #'identity ts " ")))))) -(defun jao-notmuch-format-tree-and-subject (fmt msg) +(defun jao-notmuch-format-tree-and-subject (_fmt msg) (let ((tr (notmuch-tree-format-field "tree" " %s" msg)) - (sb (notmuch-tree-format-field "subject" " %s" msg))) + (sb (notmuch-tree-format-field "subject" " %s" msg)) + (fmt (format "%%>-%ds" (- (window-width) 60)))) (format-spec fmt `((?s . ,(concat tr sb)))))) (defun jao-notmuch-format-msg-ticks (mails-rx msg) @@ -398,4 +398,24 @@ (t " ")))) (provide 'jao-notmuch) +;;; org links +(defun jao-notmuch-id-file-name (id) + (let ((cmd (format "notmuch search --output=files id:%s" id))) + (car (split-string (shell-command-to-string cmd))))) + +(defun jao-notmuch-org-store () + (when-let* ((d (and (derived-mode-p '(notmuch-show-mode notmuch-tree-mode)) + (cons (notmuch-show-get-message-id) + (notmuch-show-get-subject))))) + (org-link-store-props :type "mail" + :link (concat "mail:" (car d)) + :description (concat "Mail: " (cdr d))))) + +(defun jao-notmuch-org-links () + (org-link-set-parameters "mail" + :follow #'notmuch-show + :store #'jao-notmuch-org-store) + (org-link-set-parameters "gnus" :store #'ignore) + (org-link-set-parameters "notmuch" :store #'ignore)) + ;;; jao-notmuch.el ends here 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..8faa6b1 --- /dev/null +++ b/lib/prog/jao-clojure.el @@ -0,0 +1,191 @@ +;;; 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) +(require 'cider-test) +(require 'jao-skel) + +;;;; 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) + (replace-regexp-in-string "\\." sep + (cider-test-default-test-ns-fn 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--to-fname (x) + (replace-regexp-in-string "-" "_" x)) + +(defun jao-clojure-jump-to-test () + "Jump from implementation to test file." + (interactive) + (let* ((tn (jao-clojure--test-for (clojure-find-ns) "/")) + (bn (file-name-extension buffer-file-name)) + (f (format "%s%s/%s.%s" + (jao-clojure--root) + "test" + (jao-clojure--to-fname tn) + (jao-clojure--to-fname bn)))) + (find-file f))) + +(defun jao-clojure--implementation-for (namespace) + (thread-last (replace-regexp-in-string "-test$" "" namespace) + (replace-regexp-in-string "\\.test\\." ".") + (replace-regexp-in-string "-" "_") + (replace-regexp-in-string "\\." "/") + (substring-no-properties))) + +(defun jao-clojure--find-implementation (src) + (let ((f (format "%s%s/%s.%s" + (jao-clojure--root) + 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))) + +(defun jao-clojure--setup-compilation (&optional ns) + ;; (set (make-local-variable 'compile-command) (jao-clojure--test-str ns)) + ) + +;;;; Skeletons +(defconst jao-clojure--ns-destruct-rx + (format "\\(?:%s\\|tests?\\)\\.\\(?:clj[cs]?\\.\\)?\\(.+\\)" + (regexp-opt jao-clojure--src-candidates))) + +(defun jao-clojure-buffer-namespace () + (let* ((ddir (jao-compilation-root)) + (mbase (and ddir + (concat (replace-regexp-in-string "/" "." ddir) "."))) + (mbase (and mbase + (string-match jao-clojure--ns-destruct-rx mbase) + (match-string 1 mbase)))) + (concat (or mbase "") + (replace-regexp-in-string "_" "-" (jao-skel-basename))))) + +(defvar jao-clojure--test-check-lines + (concat "[clojure.test.check :as tc]\n " + "[clojure.test.check.generators :as gen]\n " + "[clojure.test.check.properties :as prop :include-macros true]\n")) + +(defun jao-clojure--cljs-test-reqs (prefix-cmp last-cmp test-check) + (concat " (:require [cljs.test :as t :refer-macros [is deftest async]]" + "\n [" prefix-cmp "." last-cmp " :as " last-cmp "])")) + +(defun jao-clojure--clj-test-reqs (prefix-cmp last-cmp test-check) + (format "(:use clojure.test)\n (:require %s(%s [%s :as %s]))" + (if test-check + (concat "(clojure.test.check [clojure-test :refer [defspec]])\n" + jao-clojure--test-check-lines) + "") + prefix-cmp last-cmp last-cmp)) + +(defun jao-clojure--cljc-test-reqs (prefix-cmp last-cmp test-check) + (concat "(:require #?(:clj [clojure.test :as t :refer [is deftest]]\n" + " :cljs [cljs.test :as t :refer-macros [is deftest]])\n" + (when test-check + (concat " [clojure.test.check-clojure-test #?@(" + ":cljs [:refer-macros [defspec]]\n" + ":clj [:refer [defspec]))]\n" + jao-clojure--test-check-lines)) + " [" prefix-cmp "." last-cmp " :as " last-cmp "])")) + +(defun jao-clojure--skel-ns-contents (ns) + (if (jao-clojure--test-namespace-p ns) + (let ((test-check (y-or-n-p "Include test.check requires? ")) + (ns (concat (match-string 1 ns) (match-string 3 ns)))) + (let* ((cmps (split-string ns "\\.")) + (last-cmp (car (last cmps))) + (prefix-cmp (mapconcat 'identity (butlast cmps) ".")) + (ext (file-name-extension buffer-file-name))) + (cond ((string= "cljs" ext) + (jao-clojure--cljs-test-reqs prefix-cmp last-cmp test-check)) + ((string= "cljc" ext) + (jao-clojure--cljc-test-reqs prefix-cmp last-cmp test-check)) + ((string= "clj" ext) + (jao-clojure--clj-test-reqs prefix-cmp last-cmp test-check))))) + (format "%S" (read-string "Brief module description: ")))) + +(define-skeleton jao-clojure-skeleton + "Standard Clojure module file skeleton" + "" + (jao-skel-copyright-line ";; ") + \n + (jao-skel-author-line ";; Author: ") + (jao-skel-date-line ";; Start date: ") + \n '(setq v1 (jao-clojure-buffer-namespace)) + _ "(ns " v1 + '(jao-clojure--setup-compilation v1) + \n (jao-clojure--skel-ns-contents v1) ")" + \n + '(ignore-errors (indent-region (region-beginning) (region-end))) + > -) + +(jao-skel-install "\\.clj[sc]?$" 'jao-clojure-skeleton) + + +(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..7f75c68 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") @@ -93,6 +90,7 @@ (gnus-cite-2 (c "slate gray" nil)) (gnus-cite-3 (c "slate gray" nil)) (gnus-cite-4 (c "slate gray" nil)) + (gnus-face-4 (p f11) :family "Triplicate C4c") (gnus-header-name (c fg-light)) (gnus-summary-selected (c green) nbf) (gnus-summary-cancelled (c "sienna3" nil) st) @@ -101,13 +99,24 @@ (magit-diff-context-highlight (c nil yellow) ex) (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 + (c "seashell3" nil) + :box (:line-width 1 :color "#dfdfdf" :style flat-button)) + (mode-line-active + (c "#3f3f3f" "gray96") + :box (:line-width 1 :color "#dfdfdf" :style flat-button)) (mode-line-inactive - (c "grey40" bg-light) :box (:line-width 1 :color "grey80")) + (c "#afafaf" nil) + :box (:line-width 1 :color "#efefdf" :style flat-button)) (mode-line-buffer-id (~ default) (c nil nil) nit) (mode-line-emphasis (c green nil)) (mode-line-highlight (c green nil)) + (org-agenda-calendar-event (p f02)) + (org-agenda-structure (c nil "#efefef") ex) + (org-agenda-date (~ default)) + (org-agenda-date-today (~ org-agenda-structure) ex) (org-link (p link) (ul "grey80")) + (org-time-grid (c "grey60" nil)) (tab-bar (~ header-line) :family "Source Code Pro") (scroll-bar (c "grey80" nil)) (show-paren-match (c nil "grey85")) @@ -115,8 +124,9 @@ (shr-link (~ link) (ul light-gray)) (shr-code (c blue nil)) (success (c green)) - (vertical-border (c "grey70" nil)) + (vertical-border (c "#dfdfdf" nil)) (vterm-color-yellow (c "darkgoldenrod4" yellow)) + (window-divider (c "grey99" nil)) (widget-button (~ default) nit (ul "grey80")))) ;; (enable-theme 'jao-light) diff --git a/lib/themes/jao-themes.el b/lib/themes/jao-themes.el index b1aa265..d34dc70 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,13 +320,13 @@ (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) - (bbdb-field-name bf) + (bbdb-field-name (p f00)) (bbdb-field-value (~ default)) - (bbdb-name ul) + (bbdb-name (p f01)) (bmk-mgr-bookmark-face (~ default)) (bmk-mgr-folder-face bf) (bmk-mgr-sel-bookmark-face link) @@ -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) @@ -958,7 +967,7 @@ (org-table (p f01)) (org-tag (p dimm) nbf) (org-target ul) - (org-time-grid (c nil nil)) + (org-time-grid (p dimm)) (org-todo nbf niv (p error)) (org-upcoming-deadline (p f02)) (org-verbatim (p hilite)) @@ -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))) |