diff options
Diffstat (limited to 'lib/net')
| -rw-r--r-- | lib/net/jao-eww-session.el | 186 | ||||
| -rw-r--r-- | lib/net/jao-notmuch-gnus.el | 255 | ||||
| -rw-r--r-- | lib/net/jao-notmuch.el | 118 | ||||
| -rw-r--r-- | lib/net/jao-proton-utils.el | 141 | ||||
| -rw-r--r-- | lib/net/jao-r2e.el | 231 | ||||
| -rw-r--r-- | lib/net/jao-url.el | 45 | ||||
| -rw-r--r-- | lib/net/randomsig.el | 93 |
7 files changed, 678 insertions, 391 deletions
diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el index 4ac5447..76da717 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)))) + (let ((s (or s (jao-eww-session--current)))) + (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..9b408c2 --- /dev/null +++ b/lib/net/jao-notmuch-gnus.el @@ -0,0 +1,255 @@ +;;; 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) + +;;; 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..154f0d5 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 @@ -34,7 +34,7 @@ ;;; targetting the displayed message from the tree view (defvar-local jao-notmuch--tree-buffer nil) -(declare eww--url-at-point "eww") +(declare-function eww--url-at-point "eww") (defun jao-notmuch-goto-message-buffer (&optional and-click no-record) (interactive "P") @@ -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 @@ -186,7 +186,7 @@ (let* ((b notmuch-tree-message-buffer) (show (not (buffer-local-value 'jao-notmuch--showing-images b))) (mm-text-html-renderer 'shr) - (shr-blocked-images (unless show shr-blocked-images)) + ;; (shr-blocked-images (unless show shr-blocked-images)) (shr-inhibit-images (not show)) (notmuch-show-text/html-blocked-images (unless show notmuch-show-text/html-blocked-images)) @@ -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,31 @@ (let ((tags (plist-get (notmuch-tree-get-message-properties) :orig-tags))) (jao-notmuch-tree--tag tags nil))) +(defvar jao-notmuch--shared-tags + '("new" "unread" "flagged" "signed" "sent" "attachment" "forwarded" "inbox" + "encrypted" "gmane" "gnus" "feeds" "rss" "mce" "trove" "prog" "emacs")) + +(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 +381,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 +408,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 deleted file mode 100644 index 62b97b3..0000000 --- a/lib/net/jao-proton-utils.el +++ /dev/null @@ -1,141 +0,0 @@ -;; jao-proton-utils.el -- simple interaction with Proton mail and vpn - -;; Copyright (c) 2018, 2019, 2020, 2023 Jose Antonio Ortega Ruiz - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> -;; Start date: Fri Dec 21, 2018 23:56 - -;;; Comentary: - -;; This is a very simple comint-derived mode to run the CLI version -;; of PM's Bridge within the comfort of emacs. - -;;; Code: - -(define-derived-mode proton-bridge-mode comint-mode "proton-bridge" - "A very simple comint-based mode to run ProtonMail's bridge" - (setq comint-prompt-read-only t) - (setq comint-prompt-regexp "^>>> ")) - -;;;###autoload -(defun run-proton-bridge () - "Run or switch to an existing bridge process, using its CLI" - (interactive) - (pop-to-buffer (make-comint "proton-bridge" "protonmail-bridge" nil "-c")) - (unless (eq major-mode 'proton-bridge-mode) - (proton-bridge-mode))) - -;;;###autoload -(defun proton-bridge-sendmail-setup () - "Configure message sending for local proton bridge." - (setq send-mail-function #'smtpmail-send-it) - (setq message-send-mail-function #'smtpmail-send-it) - (setq smtpmail-servers-requiring-authorization - (regexp-opt '("localhost" "127.0.0.1"))) - (setq smtpmail-auth-supported '(plain login)) - (setq smtpmail-smtp-user "mail@jao.io") - (setq smtpmail-smtp-server "localhost") - (setq smtpmail-smtp-service 1025)) - -(defvar jao-proton-vpn-font-lock-keywords '("\\[.+\\]")) - -;;;###autoload -(defun proton-vpn-mode () - "A very simple mode to show the output of ProtonVPN commands" - (interactive) - (kill-all-local-variables) - (buffer-disable-undo) - (use-local-map proton-vpn-mode-map) - (setq-local font-lock-defaults '(jao-proton-vpn-font-lock-keywords)) - (setq-local truncate-lines t) - (setq-local next-line-add-newlines nil) - (setq major-mode 'proton-vpn-mode) - (setq mode-name "proton-vpn") - (read-only-mode 1)) - -(defvar jao-proton-vpn--buffer "*pvpn*") - -(defun jao-proton-vpn--do (things) - (let ((b (pop-to-buffer (get-buffer-create jao-proton-vpn--buffer)))) - (let ((inhibit-read-only t) - (cmd (format "protonvpn-cli %s" things))) - (delete-region (point-min) (point-max)) - (message "Running: %s ...." cmd) - (shell-command cmd b) - (message "")) - (proton-vpn-mode))) - -;;;###autoload -(defun proton-vpn-status () - (interactive) - (jao-proton-vpn--do "s")) - -(defun proton-vpn--get-status () - (or (when-let ((b (get-buffer jao-proton-vpn--buffer))) - (with-current-buffer b - (goto-char (point-min)) - (if (re-search-forward "^Status: *\\(.+\\)$" nil t) - (match-string-no-properties 1) - (when (re-search-forward "^Connected!$") - "Connected")))) - "Disconnected")) - -;;;###autoload -(defun proton-vpn-connect (cc) - (interactive "P") - (let ((cc (when cc (read-string "Country code: ")))) - (jao-proton-vpn--do (if cc (format "c --cc %s" cc) "c --sc")) - (proton-vpn-status))) - -(defun proton-vpn-reconnect () - (interactive) - (jao-proton-vpn--do "r")) - -(setenv "PVPN_WAIT" "300") - -;;;###autoload -(defun proton-vpn-maybe-reconnect () - (interactive) - (when (string= "Connected" (proton-vpn--get-status)) - (jao-proton-vpn--do "d") - (sit-for 5) - (jao-proton-vpn--do "r"))) - -;;;###autoload -(defun proton-vpn-disconnect () - (interactive) - (jao-proton-vpn--do "d")) - -(setq proton-vpn-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (define-key map [?q] 'bury-buffer) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?g] 'proton-vpn-status) - (define-key map [?r] 'proton-vpn-reconnect) - (define-key map [?d] (lambda () - (interactive) - (when (y-or-n-p "Disconnect?") - (proton-vpn-disconnect)))) - (define-key map [?c] 'proton-vpn-connect) - map)) - - -(provide 'jao-proton-utils) -;;; jao-proton.el ends here diff --git a/lib/net/jao-r2e.el b/lib/net/jao-r2e.el new file mode 100644 index 0000000..f28b66b --- /dev/null +++ b/lib/net/jao-r2e.el @@ -0,0 +1,231 @@ +;;; jao-r2e.el --- List of rss2email subscriptions -*- lexical-binding: t; -*- + +;; Copyright (C) 2025, 2026 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 'multisession) +(require 'jao-url) + +(autoload 'View-quit "view") +(autoload 'eww-view-source "eww") +(autoload 'jao-notmuch-subtags "jao-notmuch") + +(defvar jao-r2e-command "r2e") +(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 "%s %s" jao-r2e-command 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))) + (forward-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)))) + (when (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)) + (sfmt (format "%%s add %s '%s' mail+feeds_%s@jao.io" name url cat))) + (with-temp-message "Subscribing..." + (shell-command-to-string (format sfmt "r2e")) + (when (not (string= jao-r2e-command "r2e")) + (shell-command-to-string (format sfmt jao-r2e-command)))) + (when (y-or-n-p "Retrieve feeds now? ") + (with-temp-message "Retrieving feed..." + (shell-command (format "%s run %s" jao-r2e-command name)))) + (when relist (jao-r2e-list))))))) + +(provide 'jao-r2e) +;;; jao-r2e.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 diff --git a/lib/net/randomsig.el b/lib/net/randomsig.el index cb37694..e3c735b 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 @@ -305,7 +308,7 @@ You probably want to have a newline at the end of it." ;; get a list with file names of signature files (let ((sigfiles (randomsig-files-to-list files))) ;; Insert all files into the newly created buffer - (mapcar + (mapc (lambda (fname) (let ((pos (point-max))) @@ -345,10 +348,10 @@ You probably want to have a newline at the end of it." (defun randomsig-goto-signature () -;; This function is stolen fom message-goto signature. -;; Go to beginnig of the signature, and return t. -;; If there is no signature in current buffer, go to end of buffer, -;; and return nil. + ;; This function is stolen fom message-goto signature. + ;; Go to beginnig of the signature, and return t. + ;; If there is no signature in current buffer, go to end of buffer, + ;; and return nil. (goto-char (point-min)) (if (re-search-forward "^-- $" nil t) (progn @@ -380,30 +383,25 @@ Else a signature out of `randomsig-files' will be choosen." (randomsig-read-signatures-to-buffer randomsig-buffer-name files) (goto-char (point-min)) - (let '(count 0) 'selected - - ;; Count number of signatures - (while (search-forward-regexp randomsig-delimiter-pattern nil t) - (setq count (1+ count))) - - ;; Select random signature out out these - (setq selected (1+ (random count))) - (goto-char (point-min)) - (if (search-forward-regexp randomsig-delimiter-pattern nil t selected) - (forward-char)) - - ;; Cut signature and return it - (let '(here (point)) 'signature-string - - (if (not (search-forward-regexp randomsig-delimiter-pattern - nil t)) - (goto-char (point-max)) - (beginning-of-line)) - (setq signature-string - (concat randomsig-static-string - (buffer-substring here (point)))) - (kill-buffer randomsig-buffer-name) - signature-string)))) + (let ((count 0) (selected nil)) + ;; Count number of signatures + (while (search-forward-regexp randomsig-delimiter-pattern nil t) + (setq count (1+ count))) + ;; Select random signature out out these + (setq selected (1+ (random count))) + (goto-char (point-min)) + (if (search-forward-regexp randomsig-delimiter-pattern nil t selected) + (forward-char)) + ;; Cut signature and return it + (let ((here (point)) + (signature-string nil)) + (if (not (search-forward-regexp randomsig-delimiter-pattern nil t)) + (goto-char (point-max)) + (beginning-of-line)) + (setq signature-string + (concat randomsig-static-string (buffer-substring here (point)))) + (kill-buffer randomsig-buffer-name) + signature-string)))) (defun randomsig-replace-sig (arg) @@ -412,34 +410,31 @@ When called with prefix, read the filename of the signature-file that should be used" (interactive "P") (save-excursion - (randomsig-replace-signature (randomsig-signature (if arg (randomsig-prompt "read from signature-lib: ") randomsig-files))))) - - (defun randomsig-message-read-sig (arg) "Get the signature of current message and copy it to a file. If mark is active, get the marked region instead. When called with prefix, let the user edit the signature before saving" (interactive "P") (save-excursion - (let '(signature-string + (let ((signature-string (if (randomsig-mark-active-p) (buffer-substring (point) (mark)) (progn (if (randomsig-goto-signature) - (let `(here (point)) + (let ((here (point))) (goto-char (point-max)) (while (char-equal (char-before) 10) (backward-char)) (buffer-substring here (point))) - nil)))) + nil))))) (when signature-string (if arg (progn @@ -448,7 +443,6 @@ When called with prefix, let the user edit the signature before saving" (randomsig-edit signature-string)) (randomsig-write-signature signature-string)))))) - (defun randomsig-write-signature (signature-string) (set-buffer (find-file-noselect (expand-file-name @@ -462,14 +456,13 @@ When called with prefix, let the user edit the signature before saving" (save-buffer)) -(defun gnus/randomsig-summary-read-sig (arg) - "Get the signature of current message and copy it to a file" - (interactive "P") - (progn ;save-excursion - ;; FIXME: Doesn't return to summary buffer (save-excursion should do this) - (gnus-summary-select-article-buffer) - (randomsig-message-read-sig arg))) - +;; (defun gnus/randomsig-summary-read-sig (arg) +;; "Get the signature of current message and copy it to a file" +;; (interactive "P") +;; (progn ;save-excursion +;; ;; FIXME: Doesn't return to summary buffer (save-excursion should do this) +;; (gnus-summary-select-article-buffer) +;; (randomsig-message-read-sig arg))) (defun randomsig-search-sigfiles (&optional file) "Scan `randomsig-dir' and its subdirectories for regular files. @@ -486,7 +479,7 @@ If FILE is given, only FILE and its subdirectory will be searched." ;; unwanted... nil - (let '(path (expand-file-name file randomsig-dir)) + (let ((path (expand-file-name file randomsig-dir))) (if (file-directory-p path) (mapcan (lambda (f) (randomsig-search-sigfiles (if (string= file "") @@ -568,7 +561,7 @@ You most likely do not want to call `randomsig-edit-mode' directly. \\{randomsig-edit-mode-map}" (define-key randomsig-edit-mode-map - (kbd "C-c C-c") 'randomsig-edit-done)) + (kbd "C-c C-c") 'randomsig-edit-done)) ;;; Commands for randomsig-select-mode |