diff options
Diffstat (limited to 'lib/net')
| -rw-r--r-- | lib/net/jao-eww-session.el | 182 | ||||
| -rw-r--r-- | lib/net/jao-notmuch-gnus.el | 61 | ||||
| -rw-r--r-- | lib/net/jao-notmuch.el | 251 | ||||
| -rw-r--r-- | lib/net/jao-proton-utils.el | 141 | ||||
| -rw-r--r-- | lib/net/jao-r2e.el | 249 | ||||
| -rw-r--r-- | lib/net/jao-url.el | 45 | ||||
| -rw-r--r-- | lib/net/randomsig.el | 93 |
7 files changed, 623 insertions, 399 deletions
diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el index 3c60cf8..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,10 +45,6 @@ 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))) @@ -113,120 +62,45 @@ the session is already displayed in a eww tab, jao-eww-session can: (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 index 1a03613..9b408c2 100644 --- a/lib/net/jao-notmuch-gnus.el +++ b/lib/net/jao-notmuch-gnus.el @@ -1,6 +1,6 @@ ;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- -;; Copyright (C) 2022, 2024 jao +;; Copyright (C) 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -52,7 +52,7 @@ "Interactively add or remove tags to the current message." (interactive) (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (unless tags (jao-notmuch-gnus-message-tags 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) @@ -65,6 +65,11 @@ (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))) @@ -76,9 +81,9 @@ (message "New tags: %s" (jao-notmuch-gnus-message-tags id)))) (defun jao-notmuch-gnus-tag-mark () - "Remove the new tag for an article when it's marked as seen by Gnus." + "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") t))) + (jao-notmuch-gnus-tag-message id '("-new" "-unread") t))) (add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark) @@ -105,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)))) @@ -171,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 "~"))) @@ -208,20 +237,18 @@ Example: (org-link-set-parameters "gnus" :store #'ignore) (org-link-set-parameters "notmuch" :store #'ignore) -;;; consult-notmuch +;;; tags and flags -(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-notmuch-gnus-flag-current (&rest _) + (jao-notmuch-gnus-tag-message nil '("+flagged") t)) - (defun jao-gnus-consult-notmuch () - "Run a consult-notmuch query that opens candidates in Gnus." - (interactive) - (jao-notmuch-gnus--open-candidate (consult-notmuch--search))) +(defun jao-notmuch-gnus-unflag-current (&rest _) + (jao-notmuch-gnus-tag-message nil '("-flagged") t)) - (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) +(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) diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el index 2dc4b70..db23bc1 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 @@ -25,16 +25,152 @@ (require 'outline) (require 'mm-decode) (require 'mm-view) +(require 'shr) +(require 'ol) +(require 'browse-url) (require 'notmuch) (require 'notmuch-tree) (require 'notmuch-show) +;;; searches +(defvar jao-notmuch--new nil) +(defvar jao-notmuch--new-rx nil) +(defvar jao-notmuch--newa nil) + +(defvar jao-notmuch-widened-searches nil) + +(defun jao-notmuch--tags-q (tags) + (format "tag:\"/^(%s)$/\"" (mapconcat (lambda (s) (format "%s" s)) tags "|"))) + +(defun jao-notmuch--new (&rest tags) + (cond ((listp jao-notmuch--new) + (jao-notmuch--tags-q (append jao-notmuch--new tags))) + (tags (concat jao-notmuch--new " OR " (jao-notmuch--tags-q tags))) + (t jao-notmuch--new))) + +(defun jao-notmuch--set-new-search (s) + (setq jao-notmuch--new s + jao-notmuch--new-rx (regexp-quote (jao-notmuch--new)) + jao-notmuch--newa (concat (jao-notmuch--new) " AND "))) + +(defun jao-notmuch--q (d0 &optional k d1 qs st) + (let* ((qs (when qs (mapconcat (lambda (q) (format "%s" q)) qs " AND "))) + (q (or qs + (concat (jao-notmuch--new) + (mapconcat (lambda (d) (when d (concat " AND tag:" d))) + (list d0 d1)))))) + (list :name (concat d0 (when (and d1 (not (string= "" d1))) "/") d1) + :key k :query q :search-type (or st 'tree) + :sort-order 'oldest-first))) + +(defun jao-notmuch--q-feed (q) + (apply #'jao-notmuch--q (cons "feeds" q))) + +;;;###autoload +(defun jao-notmuch-init-searches (s &optional other) + (jao-notmuch--set-new-search s) + + (setq notmuch-hello-sections nil + notmuch-saved-searches nil + jao-notmuch-widened-searches nil) + + (when other (jao-notmuch-def-searches (car other) (cdr other)))) + +;;;###autoload +(defun jao-notmuch-tree-widen-search () + (interactive) + (when-let* ((query (notmuch-tree-get-query))) + (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))) + (notmuch-tree-close-message-window) + (notmuch-tree (string-replace jao-notmuch--newa "" query))))) + +(defun jao-notmuch--widen (s &optional extra) + (let* ((q (plist-get s :query)) + (qs (string-replace jao-notmuch--newa "" q))) + (plist-put (copy-sequence s) :query (concat qs extra)))) + +;;;###autoload +(defun jao-notmuch-widen-searches (searches &optional extra) + (mapcar (lambda (s) (jao-notmuch--widen s extra)) searches)) + +(defun jao-notmuch-hello--insert-searches (searches title title-face) + (when-let* ((searches (notmuch-hello-query-counts searches))) + (let* ((cnt (when title + (seq-reduce (lambda (c q) + (+ c (or (plist-get q :count) 0))) + searches + 0))) + (title (when title (format "%d %s" cnt title))) + (notmuch-column-control 1.0) + (title-face (or title-face 'jao-themes-f00))) + (when title + (widget-insert (propertize title 'face title-face)) + (newline) + (jao-notmuch-hbar 5)) + (notmuch-hello-insert-buttons searches) + (newline)))) + +(defun jao-notmuch--replace (lst s) + (let ((name (plist-get s :name))) + (set lst (seq-remove (lambda (s0) (string= name (plist-get s0 :name))) + (symbol-value lst))) + (add-to-list lst s t))) + +;;;###autoload +(defun jao-notmuch-def-searches (name searches &optional no-save title-face) + (declare (indent 1)) + (unless no-save + (dolist (s searches) + (jao-notmuch--replace 'jao-notmuch-widened-searches + (jao-notmuch--widen s)) + (jao-notmuch--replace 'notmuch-saved-searches s))) + (add-to-list 'notmuch-hello-sections + `(jao-notmuch-hello--insert-searches ,searches ,name ,title-face) + t)) + +;;; jump to searches +(defun jao-notmuch--searches-w/new (searches) + (seq-filter (lambda (s) + (string-match-p jao-notmuch--new-rx (plist-get s :query))) + (notmuch-hello-query-counts searches))) + +(defconst jao-notmuch--search-keys '("a" "s" "d" "f" "g" "h" "j" "k" "l")) + +(defun jao-notmuch--index-searches (searches) + (seq-map-indexed (lambda (q i) + (plist-put q :key (or (elt jao-notmuch--search-keys i) + (format "%s" i)))) + searches)) + +;;;###autoload +(defun jao-notmuch-jump-search (&optional widen) + (interactive "P") + (let ((notmuch-saved-searches + (if widen jao-notmuch-widened-searches notmuch-saved-searches))) + (notmuch-jump-search))) + +;;;###autoload +(defun jao-notmuch-jump () + "Jump to a saved, non-zero count search." + (interactive) + (if-let* ((searches (jao-notmuch--searches-w/new notmuch-saved-searches))) + (if (= 2 (length searches)) + (let* ((q (seq-remove (lambda (q) (string= "new" (plist-get q :name))) + searches)) + (q (car q)) + (of (eq 'oldest-first (plist-get q :sort-order))) + (query (plist-get q :query))) + (notmuch-tree query nil nil nil nil nil nil of t)) + (let ((notmuch-saved-searches (jao-notmuch--index-searches searches))) + (notmuch-jump-search))) + (jao-notmuch-jump-search t))) + ;;; 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") @@ -167,7 +303,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 @@ -183,10 +319,11 @@ (defvar-local jao-notmuch--showing-images nil) (defun jao-notmuch--shr-toggle-images () + (require 'eww) (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,7 +349,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)))) @@ -265,8 +402,10 @@ (tb (seq-find (lambda (b) (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))) + (buffer-list))) + (subject (propertize subject 'face 'message-header-subject))) + `((:eval + (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject))) (concat " " subject))) (defun jao-notmuch--format-lighter () @@ -316,6 +455,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 +484,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 +519,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 +546,33 @@ (t " ")))) (provide 'jao-notmuch) + +;;; bars +(defvar jao-notmuch-bar-max 188) + +(defun jao-notmuch-hbar (margin) + (let ((w (- (min (window-width) jao-notmuch-bar-max) margin))) + (widget-insert (propertize (make-string w ?—) 'face '(:foreground "grey80")))) + (newline)) + +;;; 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 0c9ccd7..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..76fed8f --- /dev/null +++ b/lib/net/jao-r2e.el @@ -0,0 +1,249 @@ +;;; 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))))) + +;;;###autoload +(defun jao-r2e-edit-deleted () + (interactive) + (let ((kept nil)) + (dolist (feed (jao-r2e--deleted)) + (when (y-or-n-p (format "Keep %s? " feed)) + (push feed kept))) + (setf (multisession-value jao-r2e-deleted-feeds) kept) + (message "%s feeds kept" (length kept)))) + +(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-remove-shorts (url) + (if (and (string-match-p "www\.youtube\.com" url) + (y-or-n-p "Remove shorts? ")) + (string-replace "channel_id=UC" "playlist_id=UULF" url) + url)) + +;;;###autoload +(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* ((url (jao-r2e-remove-shorts url)) + (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 |