summaryrefslogtreecommitdiffhomepage
path: root/lib/net
diff options
context:
space:
mode:
Diffstat (limited to 'lib/net')
-rw-r--r--lib/net/jao-eww-session.el184
-rw-r--r--lib/net/jao-notmuch-gnus.el270
-rw-r--r--lib/net/jao-notmuch.el111
-rw-r--r--lib/net/jao-proton-utils.el4
-rw-r--r--lib/net/jao-url.el45
-rw-r--r--lib/net/randomsig.el11
6 files changed, 422 insertions, 203 deletions
diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el
index 4ac5447..adbe98f 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-2026 Jose A Ortega Ruiz
;; Author: Jose A Ortega Ruiz <jao@gnu.org>
;; Version: 0.4
@@ -21,70 +21,23 @@
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Commentary:
-
-;; jao-eww-session provides persistent eww browsing sessions. When
-;; quitting eww (or, if you request it, at any other time while using
-;; it) you can save the current eww session (that is, the set of open
-;; tabs and the URLs they're visiting). Upon restarting emacs, you'll
-;; have the possibity of recovering the saved session (that is, of
-;; re-opening the saved tabs and URLs). You also have at your disposal
-;; a command to recover the saved session at any other time, via the
-;; commands:
-;;
-;; jao-eww-session-load -- load the last stored session
-;; jao-eww-session-save -- save the current session
-;;
-;; A customization group, jao-eww-session, is available. There you can
-;; customize the following variables:
-
;;; Code:
;;; Dependencies:
(require 'eww)
(require 'url)
-
-;;; Custom variables:
-
-(defgroup jao-eww-session nil
- "eww - session saving in eww."
- :group 'eww
- :prefix "jao-eww-session-")
-
-(defcustom jao-eww-session-save-always nil
- "If on, always save eww session without asking."
- :type 'boolean)
-
-(defcustom jao-eww-session-load-always t
- "If on, always load eww session without asking."
- :type 'boolean)
-
-(defcustom jao-eww-session-show-titles t
- "If on, show URL titles in the load prompt."
- :type 'boolean)
-
-(defcustom jao-eww-session-duplicate-tabs 'never
- "How to treat session URL already being visited.
-
-When loading a session with `jao-eww-session-load', if one of the URLs in
-the session is already displayed in a eww tab, jao-eww-session can:
-- `never' create a new tab (just reload it), or
-- `always' duplicate the URL in a new tab, or
-- `ask' the user what to do."
- :type '(choice (const :value never)
- (const :value always)
- (const :value ask)))
-
-(defcustom jao-eww-session-file "~/.emacs.d/eww-session.eld"
- "File to save the eww session data."
- :type 'file)
+(require 'multisession)
;;; Internals:
;;;; auxiliary functions
-(defvar jao-eww-current-session '(jao-eww-session 0 nil))
+(define-multisession-variable jao-eww-session '(0))
+
+(defun jao-eww-session--current (&optional s)
+ (when s (setf (multisession-value jao-eww-session) s))
+ (multisession-value jao-eww-session))
(defun jao-eww-session-eww-buffers (&optional skip)
(seq-filter (lambda (b)
@@ -92,12 +45,8 @@ the session is already displayed in a eww tab, jao-eww-session can:
(with-current-buffer b (derived-mode-p 'eww-mode))))
(buffer-list)))
-(defun jao-eww-session-invisible-buffers ()
- (seq-filter (lambda (b) (null (get-buffer-window b)))
- (jao-eww-session-eww-buffers (current-buffer))))
-
(defun jao-eww--current-url ()
- (when-let (url (eww-current-url)) (url-encode-url url)))
+ (when-let* ((url (eww-current-url))) (url-encode-url url)))
(defun jao-eww-session--current-urls (&optional skip-current)
(let ((urls)
@@ -107,126 +56,51 @@ the session is already displayed in a eww tab, jao-eww-session can:
(dolist (b (jao-eww-session-eww-buffers (when skip-current cb))
(list pos (reverse urls)))
(set-buffer b)
- (when-let (url (jao-eww--current-url))
+ (when-let* ((url (jao-eww--current-url)))
(when (eq b cb) (setq pos count))
(setq count (1+ count))
(push (cons url (jao-eww-buffer-title)) urls)))))
(defun jao-eww-session-urls (&optional s)
- (let ((s (or s jao-eww-current-session)))
- (mapcar 'car (nth 2 s))))
+ (mapcar 'car (cadr (or s (jao-eww-session--current)))))
(defun jao-eww-session-offset (&optional s)
- (let ((s (or s jao-eww-current-session)))
- (nth 1 s)))
+ (car (or s (jao-eww-session--current))))
(defun jao-eww-session-titles (&optional s)
(let ((s (or s jao-eww-current-session)))
- (mapcar 'cdr (nth 2 s))))
+ (mapcar 'cdr (cadr s))))
-(defun jao-eww-session--update-current (&optional skip-current)
- (save-current-buffer
- (setq jao-eww-current-session
- (cons 'jao-eww-session (jao-eww-session--current-urls skip-current)))))
+(defun jao-eww-session--update ()
+ (jao-eww-session--current (jao-eww-session--current-urls)))
(defun jao-eww-session--find-dups (urls)
(seq-filter
(lambda (b)
- (with-current-buffer b
- (when-let (url (jao-eww--current-url))
- (when (member url urls)
- (when (y-or-n-p "Already open session, abort? ")
- (switch-to-buffer b)
- (user-error "Aborted"))
- (or (and (eq jao-eww-session-duplicate-tabs 'never))
- (not (y-or-n-p (format "'%s' (%s) is already open. Duplicate? "
- (jao-eww-buffer-title) url))))))))
+ (with-current-buffer b (member (jao-eww--current-url) urls)))
(jao-eww-session-eww-buffers)))
-(defun jao-eww-session-load-aux ()
- (let ((new-session (jao-eww-session-from-file
- (expand-file-name jao-eww-session-file))))
- (when (and new-session
- (or jao-eww-session-load-always
- (y-or-n-p
- (if jao-eww-session-show-titles
- (format "Load last eww session %S? "
- (jao-eww-session-titles new-session))
- "Load last eww session? "))))
- (setq jao-eww-current-session new-session))))
-
-(defun jao-eww-session-from-file (fname)
- (let ((fname (jao-eww-session--check--backup fname)))
- (when (file-readable-p fname)
- (with-temp-buffer
- (insert-file-contents fname)
- (goto-char (point-min))
- (let ((sexp (read (current-buffer))))
- (and (equal 'jao-eww-session (car sexp)) sexp))))))
-
-(defun jao-eww-session-not-empty () (> (length (jao-eww-session-urls)) 0))
-
-(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))))))
-
-(defun jao-eww-session--backup-name (fname)
- (concat (expand-file-name fname) ".bak"))
-
-(defun jao-eww-session--check--backup (fname)
- (let ((bfname (jao-eww-session--backup-name fname)))
- (if (and (file-newer-than-file-p bfname fname)
- (y-or-n-p "A newer autosaved session exists. Use it? "))
- bfname
- fname)))
-
-(defun jao-eww-session--save-backup (&optional skip)
- (let ((f (jao-eww-session--backup-name jao-eww-session-file)))
- (jao-eww-session--to--file f skip)))
-
-(defun jao-eww-session--save-backup-1 ()
- (when (derived-mode-p 'eww-mode) (jao-eww-session--save-backup t)))
-
;;;; save session on checkpoints
-(add-hook 'kill-emacs-query-functions #'jao-eww-session-save)
-(add-hook 'kill-buffer-hook #'jao-eww-session--save-backup-1)
-(add-hook 'eww-after-render-hook #'jao-eww-session--save-backup)
-(advice-add 'eww-back-url :after #'jao-eww-session--save-backup)
-(advice-add 'eww-forward-url :after #'jao-eww-session--save-backup)
+(add-hook 'eww-after-render-hook #'jao-eww-session--update)
+(advice-add 'eww-back-url :after #'jao-eww-session--update)
+(advice-add 'eww-forward-url :after #'jao-eww-session--update)
-;;;###autoload
(defun jao-eww-buffer-title () (plist-get eww-data :title))
-;;;###autoload
-(defun jao-eww-session-save ()
- "Save the current eww session."
- (interactive)
- (when (and (jao-eww-session-not-empty)
- (or jao-eww-session-save-always (y-or-n-p "Save eww session? ")))
- (jao-eww-session--to--file jao-eww-session-file))
- t)
-
-;;;###autoload
(defun jao-eww-session-load ()
"Load last stored session into eww."
(interactive)
- (when-let ((s (jao-eww-session-load-aux)))
- (let* ((urls (jao-eww-session-urls s))
- (offset (jao-eww-session-offset s))
- (buffers (unless (equal jao-eww-session-duplicate-tabs 'always)
- (jao-eww-session--find-dups urls))))
- (dolist (url urls) (eww url 4))
- (seq-each #'kill-buffer buffers)
- (unless (zerop offset)
- (switch-to-buffer (nth offset (jao-eww-session-eww-buffers)))))))
+ (let* ((urls (jao-eww-session-urls))
+ (offset (jao-eww-session-offset))
+ (dups (jao-eww-session--find-dups urls)))
+ (dolist (url urls) (eww url 4))
+ (seq-each #'kill-buffer dups)
+ (unless (zerop offset)
+ (switch-to-buffer (nth offset (jao-eww-session-eww-buffers))))))
+
+(defun jao-eww-session-invisible-buffers ()
+ (seq-filter (lambda (b) (null (get-buffer-window b)))
+ (jao-eww-session-eww-buffers (current-buffer))))
(provide 'jao-eww-session)
;;; jao-eww-session.el ends here
diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el
new file mode 100644
index 0000000..9a17841
--- /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, 2026 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..625c8e6 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, 2026 jao
;; Author: jao <mail@jao.io>
;; Keywords: mail
@@ -69,7 +69,7 @@
(user-error "No tree view for this buffer")))
(defun jao-notmuch-tree--looking-at-message ()
- (when-let (id (plist-get (notmuch-tree-get-message-properties) :id))
+ (when-let* ((id (plist-get (notmuch-tree-get-message-properties) :id)))
(equal (concat "*notmuch-id:" id "*")
(buffer-name (window-buffer notmuch-tree-message-window)))))
@@ -105,7 +105,7 @@
(goto-char (point-min))
(let ((pos (point)))
(while (setq pos (next-single-property-change pos 'w3m-href-anchor))
- (when-let ((url (get-text-property pos 'w3m-href-anchor)))
+ (when-let* ((url (get-text-property pos 'w3m-href-anchor)))
(when (stringp url) (cl-pushnew url res :test #'string=))))
(seq-uniq res #'string=))))
@@ -117,7 +117,7 @@
(defun jao-notmuch-browse-urls (&optional external)
(interactive "P")
- (if-let ((urls (jao-notmuch-message-urls)))
+ (if-let* ((urls (jao-notmuch-message-urls)))
(funcall (if external browse-url-secondary-browser-function #'browse-url)
(completing-read "Browse URL: " urls))
(message "No URLs in this message")))
@@ -131,22 +131,22 @@
(interactive)
(when (get-text-property (point) 'w3m-href-anchor)
(goto-char (next-single-property-change (point) 'w3m-href-anchor)))
- (if-let (pos (next-single-property-change (point) 'w3m-href-anchor))
+ (if-let* ((pos (next-single-property-change (point) 'w3m-href-anchor)))
(goto-char pos)
(or (forward-button 1 nil t t)
(ffap-next-guess))))
(defun jao-notmuch-show-previous-button ()
(interactive)
- (if-let (pos (previous-single-property-change (point) 'w3m-href-anchor))
+ (if-let* ((pos (previous-single-property-change (point) 'w3m-href-anchor)))
(goto-char (previous-single-property-change pos 'w3m-href-anchor))
(or (backward-button 1 nil t t)
(ffap-next-guess t))))
(defun jao-notmuch-show-ret ()
(interactive)
- (when-let (url (or (get-text-property (point) 'w3m-href-anchor)
- (thing-at-point-url-at-point)))
+ (when-let* ((url (or (get-text-property (point) 'w3m-href-anchor)
+ (thing-at-point-url-at-point))))
(browse-url url)))
@@ -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
@@ -212,10 +212,10 @@
(with-current-buffer notmuch-tree-message-buffer
(jao-notmuch--view-html))))))
-;;; header line with thread message counts
+;;; header and mode lines with thread message counts
(defun jao-notmuch--looking-at-new-p (&optional p)
- (when-let (ts (if p (plist-get p :tags) (notmuch-show-get-tags)))
+ (when-let* ((ts (if p (plist-get p :tags) (notmuch-show-get-tags))))
(or (member "unread" ts) (member "new" ts))))
(defsubst jao-notmuch-tree--first-p (&optional msg)
@@ -266,7 +266,8 @@
(with-current-buffer b
(and (derived-mode-p 'notmuch-tree-mode) b)))
(buffer-list))))
- `((:eval (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject)))
+ `((:eval
+ (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject)))
(concat " " subject)))
(defun jao-notmuch--format-lighter ()
@@ -316,6 +317,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 +346,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" "replied"))
+
+(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)
@@ -378,15 +378,22 @@
(or (> (length a) (length b)) (string-lessp a b)))
(defun jao-notmuch-format-tags (fmt msg)
- (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg)
- (split-string)
- ;; (seq-sort-by #'length #'<)
- (seq-sort #'jao-notmuch-cmp-tags))))
- (format-spec fmt `((?s . ,(mapconcat #'identity ts " "))))))
-
-(defun jao-notmuch-format-tree-and-subject (fmt msg)
+ (if (> (window-width) 85)
+ (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg)
+ (split-string)
+ ;; (seq-sort-by #'length #'<)
+ (seq-sort #'jao-notmuch-cmp-tags))))
+ (format-spec fmt `((?s . ,(mapconcat #'identity ts " ")))))
+ ""))
+
+(defun jao-notmuch-format-authors (threshold msg)
+ (let ((fmt (if (< (window-width) threshold) "%-15s" "%-35s")))
+ (notmuch-tree-format-field "authors" 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) 45))))
(format-spec fmt `((?s . ,(concat tr sb))))))
(defun jao-notmuch-format-msg-ticks (mails-rx msg)
@@ -398,4 +405,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-proton-utils.el b/lib/net/jao-proton-utils.el
index 62b97b3..0a08f5d 100644
--- a/lib/net/jao-proton-utils.el
+++ b/lib/net/jao-proton-utils.el
@@ -1,6 +1,6 @@
;; jao-proton-utils.el -- simple interaction with Proton mail and vpn
-;; Copyright (c) 2018, 2019, 2020, 2023 Jose Antonio Ortega Ruiz
+;; Copyright (c) 2018, 2019, 2020, 2023, 2026 Jose Antonio Ortega Ruiz
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -86,7 +86,7 @@
(jao-proton-vpn--do "s"))
(defun proton-vpn--get-status ()
- (or (when-let ((b (get-buffer jao-proton-vpn--buffer)))
+ (or (when-let* ((b (get-buffer jao-proton-vpn--buffer)))
(with-current-buffer b
(goto-char (point-min))
(if (re-search-forward "^Status: *\\(.+\\)$" nil t)
diff --git a/lib/net/jao-url.el b/lib/net/jao-url.el
new file mode 100644
index 0000000..ac66cef
--- /dev/null
+++ b/lib/net/jao-url.el
@@ -0,0 +1,45 @@
+;;; 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))))))
+
+
+(defun jao-url-email-url ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (or (search-forward-regexp "^Via: h" nil t)
+ (search-forward-regexp "^URL:[\n ]h" nil t)
+ (and (search-forward-regexp "^Link$" nil t)
+ (not (beginning-of-line))))
+ (jao-url-around-point))))
+
+(provide 'jao-url)
+;;; jao-url.el ends here
diff --git a/lib/net/randomsig.el b/lib/net/randomsig.el
index cb37694..9029f13 100644
--- a/lib/net/randomsig.el
+++ b/lib/net/randomsig.el
@@ -1,6 +1,6 @@
-;;; randomsig.el --- insert a randomly selected signature
+;;; randomsig.el --- insert a randomly selected signature -*- lexical-binding: t; -*-
-;; Copyright (C) 2001, 2002, 2013, 2020, 2021 Hans-Jürgen Ficker
+;; Copyright (C) 2001, 2002, 2013, 2020, 2021, 2024, 2026 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
generated by cgit v1.2.3 (git 2.46.0) at 2026-09-03 23:22:56 +0000