diff options
Diffstat (limited to 'lib/net')
| -rw-r--r-- | lib/net/jao-eww-session.el | 19 | ||||
| -rw-r--r-- | lib/net/jao-notmuch-gnus.el | 28 | ||||
| -rw-r--r-- | lib/net/jao-notmuch.el | 77 | ||||
| -rw-r--r-- | lib/net/jao-url.el | 45 |
4 files changed, 129 insertions, 40 deletions
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 index 5cd42fa..aa63d7c 100644 --- a/lib/net/jao-notmuch-gnus.el +++ b/lib/net/jao-notmuch-gnus.el @@ -110,8 +110,32 @@ (add-to-list 'gnus-search-expandable-keys "list") -(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) +(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)))) @@ -176,7 +200,7 @@ Example: (msg-id (when msg-id (replace-regexp-in-string "^id:" "" msg-id)))) (if (and group msg-id) (org-gnus-follow-link group msg-id) - (message "Couldn't get relevant infos for switching to Gnus.")))) + (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 "~"))) diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el index aef9757..404eab7 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 @@ -212,7 +212,7 @@ (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))) @@ -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) @@ -384,9 +384,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 +399,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..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 |