From f45fdccd49992cf9232a0b66959d38e172de7fe7 Mon Sep 17 00:00:00 2001 From: jao Date: Wed, 7 Sep 2022 05:10:40 +0100 Subject: attic reorganisation --- attic/net/jao-frm.el | 222 ------------------------------- attic/net/jao-maildir.el | 189 -------------------------- attic/net/jao-notmuch-gnus.el | 226 ------------------------------- attic/net/jao-notmuch-move.el | 75 ----------- attic/net/jao-notmuch-tree-fold.el | 139 ------------------- attic/net/jao-proton-utils.el | 131 ------------------ attic/net/nnnm.el | 265 ------------------------------------- attic/net/w3m.org | 191 -------------------------- 8 files changed, 1438 deletions(-) delete mode 100644 attic/net/jao-frm.el delete mode 100644 attic/net/jao-maildir.el delete mode 100644 attic/net/jao-notmuch-gnus.el delete mode 100644 attic/net/jao-notmuch-move.el delete mode 100644 attic/net/jao-notmuch-tree-fold.el delete mode 100644 attic/net/jao-proton-utils.el delete mode 100644 attic/net/nnnm.el delete mode 100644 attic/net/w3m.org (limited to 'attic/net') diff --git a/attic/net/jao-frm.el b/attic/net/jao-frm.el deleted file mode 100644 index 2658687..0000000 --- a/attic/net/jao-frm.el +++ /dev/null @@ -1,222 +0,0 @@ -;;; jao-frm.el --- use frm to show mailbox - -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2019, 2020 - -;; Author: Jose Antonio Ortega Ruiz -;; Keywords: mail - -;; 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. - -;;; Commentary: - -;; Little hack to see the contents of your mailbox using GNU mailutils' -;; `frm' program. -;; -;; Just put (require 'jao-frm) in your .emacs, and M-x jao-frm will pop up a -;; new window with your mailbox contents (from and subject) as -;; printed by frm. In this buffer, use `n' and `p' to move, `q' to close -;; the window. `g' will call Gnus. -;; - -;;; Code: - -;;;; Customisation: - -(defgroup jao-frm nil - "Frm-base mailbox checker" - :group 'mail - :prefix "jao-frm-") - -(defcustom jao-frm-exec-path "frm" - "frm executable path" - :group 'jao-frm - :type 'file) - -(defcustom jao-frm-mail-command 'gnus - "Emacs function to invoke when `g' is pressed on an frm buffer." - :group 'jao-frm - :type 'symbol) - -(defcustom jao-frm-mailboxes nil - "List of mailboxes to check, or directory containing them." - :group 'jao-frm - :type '(choice directory (repeat file))) - -(defface jao-frm-mailno-face '((t (:foreground "dark slate grey"))) - "Face for the mail number." - :group 'jao-frm) - -(defface jao-frm-from-face '((t (:foreground "slate grey"))) - "Face for From: header." - :group 'jao-frm) - -(defface jao-frm-subject-face '((t (:foreground "slate blue"))) - "Face for Subject: header." - :group 'jao-frm) - -(defface jao-frm-mailbox-face '((t (:bold t :weight bold))) - "Face for mailbox name." - :group 'jao-frm) - -;;;; Mode: - -(defvar jao-frm-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (define-key map [?q] 'jao-frm-delete-window) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?r] 'jao-frm) - (define-key map [?g] (lambda () - (interactive) - (funcall jao-frm-mail-command))) - (define-key map [(control k)] 'jao-frm-delete-message) - map)) - -(setq jao-frm-font-lock-keywords - '(("^[^ :]+:" . 'jao-frm-mailbox-face) - ("^\\([ 0-9]+\\):\t+\\([^\t]+\\)\t+\\([^\n]+$\\)" - (1 'jao-frm-mailno-face) - (2 'jao-frm-from-face) - (3 'jao-frm-subject-face)))) - -(defvar jao-frm-mode-syntax-table - (let ((st (make-syntax-table))) - st)) - -(defun jao-frm-mode () - "Major mode for displaying frm output." - (interactive) - (kill-all-local-variables) - (buffer-disable-undo) - (use-local-map jao-frm-mode-map) - (set (make-local-variable 'font-lock-defaults) - '(jao-frm-font-lock-keywords)) - (set (make-local-variable 'truncate-lines) t) - (set (make-local-variable 'kill-whole-line) t) - (set (make-local-variable 'next-line-add-newlines) nil) - (setq major-mode 'jao-frm-mode) - (setq mode-name "frm") - (read-only-mode 1) - (goto-char 1)) - -;;;; Mode commands: -(defvar jao-frm-last-config nil) - -(defun jao-frm-delete-window () - "Delete frm window and restore last win config" - (interactive) - (if (and (consp jao-frm-last-config) - (window-configuration-p (car jao-frm-last-config))) - (progn - (set-window-configuration (car jao-frm-last-config)) - (goto-char (cadr jao-frm-last-config)) - (setq jao-frm-last-config nil)) - (bury-buffer))) - -(defun jao-frm-delete-message () - "Delete message at point" - (interactive) - (when (eq (current-buffer) (get-buffer "*frm*")) - (beginning-of-line) - (when (search-forward-regexp "^ +\\([0-9]+\\):" nil t) - (let ((mn (string-to-number (match-string 1)))) - (when (y-or-n-p (format "Delete message number %d? " mn)) - (read-only-mode -1) - (shell-command (format "echo 'd %d'|mail" mn) t) - (jao-frm) - (when (= (point-max) (point-min)) - (jao-frm-delete-window) - (message "Mailbox is empty"))))))) - -;;;; Activate frm: -(defun jao-frm-mbox-mails (mbox) - (let ((no (ignore-errors - (substring - (shell-command-to-string (format "frm -s n %s|wc -l" mbox)) - 0 -1)))) - (if (stringp no) (string-to-number no) 0))) - -(defun jao-frm-mail-number () - (let ((no 0)) - (dolist (b (jao-frm-mboxes) no) (setq no (+ no (jao-frm-mbox-mails b)))))) - -(defun jao-frm-default-count-formatter (m n) - (format "%s: %s" (file-name-sans-extension (file-name-nondirectory m)) n)) - -(defun jao-frm-mail-counts (fmt) - (let ((fmt (or fmt 'jao-frm-default-count-formatter))) - (remove nil - (mapcar (lambda (m) - (let ((n (jao-frm-mbox-mails m))) - (unless (zerop n) (funcall fmt m n)))) - (jao-frm-mboxes))))) - -(defun jao-frm-display-mailbox (mbox) - (when (not (zerop (jao-frm-mbox-mails mbox))) - (insert (or (file-name-nondirectory mbox) mbox) ":\n\n") - (apply 'call-process - `(,jao-frm-exec-path nil ,(current-buffer) nil - "-s" "n" "-n" "-t" ,@(and mbox (list mbox)))) - (newline 2))) - -(defun jao-frm-mboxes () - (cond ((null jao-frm-mailboxes) (list (getenv "MAIL"))) - ((listp jao-frm-mailboxes) jao-frm-mailboxes) - ((stringp jao-frm-mailboxes) - (if (file-directory-p jao-frm-mailboxes) - (directory-files jao-frm-mailboxes t "^[^.]") - (list jao-frm-mailboxes))) - (t (error "Error in mbox specification. Check `jao-frm-mailboxes'")))) - -;;;###autoload -(defun jao-frm () - "Run frm." - (interactive) - (let ((fbuff (get-buffer-create "*frm*")) - (inhibit-read-only t)) - (if (not (eq fbuff (current-buffer))) - (setq jao-frm-last-config - (list (current-window-configuration) (point-marker)))) - (with-current-buffer fbuff - (delete-region (point-min) (point-max)) - (mapc 'jao-frm-display-mailbox (jao-frm-mboxes)) - (unless (eq major-mode 'jao-frm-mode) - (jao-frm-mode)) - (goto-char (point-min)) - (if (= (point-min) (point-max)) - (message "Mailbox is empty.") - (pop-to-buffer fbuff)) - (when (and (boundp 'display-time-mode) display-time-mode) - (display-time-update))))) - -;;;###autoload -(defun jao-frm-show-mail-numbers (&optional fmt) - (interactive) - (let ((counts (jao-frm-mail-counts fmt))) - (message (if counts (mapconcat 'identity counts ", ") "No mail")))) - -;;;###autoload -(defun jao-frm-mail-string () - (let ((counts (jao-frm-mail-counts - (lambda (m n) - (let ((m (substring (file-name-nondirectory m) 0 1))) - (format "%s%s" (capitalize m) n)))))) - (mapconcat 'identity counts " "))) - -(provide 'jao-frm) - -;;; jao-frm.el ends here diff --git a/attic/net/jao-maildir.el b/attic/net/jao-maildir.el deleted file mode 100644 index 18a1725..0000000 --- a/attic/net/jao-maildir.el +++ /dev/null @@ -1,189 +0,0 @@ -;; jao-maildir.el -- Utilities for reading maildirs -*- lexical-binding: t; -*- - -;; Copyright (c) 2019, 2020, 2021 jao - -;; Author: jao -;; Start date: Sun Dec 01, 2019 15:48 -;; Keywords: mail - -;; 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. - -;;; Comentary: - -;; Inspecting the contents of maildirs and reporting it. - -;;; Code: - -(require 'seq) -(require 'jao-minibuffer) - -(defvar jao-maildir-debug-p nil) -(defvar jao-maildir-echo-p t) -(defvar jao-maildir-tracked-maildirs nil) -(defvar jao-maildir-info-string "") -(defvar jao-maildir-home (expand-file-name "~/var/mail")) -(defvar jao-maildir-news-home (expand-file-name "~/var/news")) - -(defgroup jao-maildir-faces nil "Faces" - :group 'faces) -(defun jao-maildir--maildir-new (mbox) (expand-file-name "new" mbox)) - -(defun jao-maildir--maildir-new-count (mbox) - (- (length (directory-files (jao-maildir--maildir-new mbox))) 2)) - -(defface jao-maildir-emph '((t :inherit font-lock-keyword-face)) - "Face used to highlihgt non-boring tracked maildirs" - :group 'jao-maildir-faces) - -(defvar jao-maildir--maildirs nil) -(defvar jao-maildir--counts nil) -(defvar jao-maildir--label-mboxes nil) -(defvar jao-maildir--trackers nil) -(defvar jao-maildir--track-strings ()) - -(defun jao-maildir--update-counts () - (dolist (mbox jao-maildir--maildirs) - (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts))) - -(defun jao-maildir--init-counts (maildirs) - (setq jao-maildir--counts (make-hash-table :test 'equal)) - (setq jao-maildir--maildirs maildirs) - (jao-maildir--update-counts)) - -(defun jao-maildir--set-trackers (maildirs tracked-maildirs) - (jao-maildir--init-counts maildirs) - (let* ((label-mboxes (make-hash-table :test 'equal)) - (trackers (seq-map-indexed - (lambda (track idx) - (puthash (car track) () label-mboxes) - (let ((tr (seq-take track 2)) - (l (elt track 2))) - (append tr - (cond ((eq l t) '(jao-maildir-emph)) - ((null l) '(default)) - (t (list l))) - (list (or (elt track 3) idx))))) - tracked-maildirs))) - (dolist (mbox maildirs) - (let ((lb (seq-find (lambda (lb) (when lb (string-match-p lb mbox))) - (hash-table-keys label-mboxes)))) - (puthash lb (cons mbox (gethash lb label-mboxes)) label-mboxes))) - (setq jao-maildir--label-mboxes label-mboxes) - (setq jao-maildir--trackers trackers))) - -(defun jao-maildir--tracked-count (track) - (seq-reduce (lambda (c k) (+ c (gethash k jao-maildir--counts 0))) - (gethash (car track) jao-maildir--label-mboxes) - 0)) - -(defun jao-maildir--update-track-string (mbox) - (when-let ((track (seq-find (lambda (td) (string-match-p (car td) mbox)) - jao-maildir--trackers))) - (let* ((label (cadr track)) - (other (assoc-delete-all label jao-maildir--track-strings)) - (cnt (jao-maildir--tracked-count track))) - (if (> cnt 0) - (let* ((face (car (last (butlast track)))) - (order (car (last track))) - (str (propertize (format "%s%s" label cnt) 'face face)) - (str (cons label (cons order str)))) - (setq jao-maildir--track-strings (cons str other))) - (setq jao-maildir--track-strings other))))) - -;;;###autoload -(defun jao-maildir-update-info-string (&optional mbox) - (cond ((eq mbox t) - (seq-do 'jao-maildir--update-track-string jao-maildir--maildirs)) - ((stringp mbox) - (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts) - (jao-maildir--update-track-string mbox))) - (let* ((s (seq-sort-by #'cadr #'< jao-maildir--track-strings)) - (s (mapconcat 'identity (mapcar 'cddr s) " "))) - (setq jao-maildir-info-string (if (string-blank-p s) "" (concat s " ")))) - (when jao-maildir-echo-p (jao-minibuffer-refresh))) - -(defvar jao-maildir--watches nil) - -(defun jao-maildir-cancel-watchers () - (dolist (w jao-maildir--watches) (file-notify-rm-watch w)) - (setq jao-maildir--watches nil)) - -(defun jao-maildir--log-watch (mbox e) - (when jao-maildir-debug-p - (message "[%s] watch: %s: %s" (current-time-string) mbox e))) - -(defun jao-maildir--watcher (mbox cb) - (lambda (e) - (jao-maildir--log-watch e mbox) - (when (memq (cadr e) '(created deleted)) - (jao-maildir-update-info-string mbox) - (when cb (funcall cb mbox))))) - -(defun jao-maildir--setup-watches (cb) - (jao-maildir-cancel-watchers) - (setq jao-maildir--watches - (mapcar (lambda (mbox) - (file-notify-add-watch (jao-maildir--maildir-new mbox) - '(change) - (jao-maildir--watcher mbox cb))) - jao-maildir--maildirs))) - -;;;###autoload -(defun jao-maildir-setup (maildirs trackers mode-line &optional cb) - (jao-maildir--set-trackers maildirs trackers) - (cond ((eq 'mode-line mode-line) - (add-to-list 'global-mode-string 'jao-maildir-info-string t)) - ((numberp mode-line) - (jao-minibuffer-add-variable 'jao-maildir-info-string mode-line) - (jao-maildir-update-info-string t)) - (t (error "Invalid mode-line value"))) - (jao-maildir--setup-watches cb)) - -;;;###autoload -(defun jao-maildir-file-to-group (file &optional maildir newsdir) - "Calculate 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/32570, /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* ((g (directory-file-name (file-name-directory file))) - (g (replace-regexp-in-string - (file-name-as-directory (or maildir jao-maildir-home)) "" g)) - (g (replace-regexp-in-string - (file-name-as-directory (or newsdir jao-maildir-news-home)) "" g)) - (nntp (string-match-p "^\\(gmane\\|gwene\\)/" g)) - (g (cond (nntp (concat "nntp:" g)) - ((file-name-directory g) - (replace-regexp-in-string "^\\([^/]+\\)/" "nnml:\\1/" - (file-name-directory g) t)) - (t (concat "nnml:" 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))))) - -(provide 'jao-maildir) -;;; jao-maildir.el ends here diff --git a/attic/net/jao-notmuch-gnus.el b/attic/net/jao-notmuch-gnus.el deleted file mode 100644 index 1576964..0000000 --- a/attic/net/jao-notmuch-gnus.el +++ /dev/null @@ -1,226 +0,0 @@ -;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 jao - -;; Author: jao -;; 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 . - -;;; 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 (unless 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) " ")))) - -(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 tag 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))) - -(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 - -(add-to-list 'gnus-search-expandable-keys "list") - -(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) - (expr (head list))) - (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 "~/.emacs.d/gnus/Mail") - "Directory where Gnus stores its mail.") - -(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/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 infos for switching to Gnus.")))) - -(defun jao-notmuch-gnus-engine (prefix config) - (let ((prefix (file-name-as-directory (expand-file-name prefix "~"))) - (config (expand-file-name config gnus-home-directory))) - `(gnus-search-engine gnus-search-notmuch - (remove-prefix ,prefix) - (config-file ,config)))) - -;;; Org links -(defun jao-notmuch-gnus--fname (id) - (let ((cmd (format "notmuch search --output=files id:%s" id))) - (car (split-string (shell-command-to-string cmd))))) - -(defun jao-notmuch-gnus-org-follow (id) - (when-let* ((fname (jao-notmuch-gnus--fname id)) - (group (jao-notmuch-gnus-file-to-group fname))) - (org-gnus-follow-link group id))) - -(defun jao-notmuch-gnus-org-store () - (when-let (d (or (when (derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) - (cons (notmuch-show-get-message-id) - (notmuch-show-get-subject))) - (when (derived-mode-p 'gnus-summary-mode 'gnus-article-mode) - (cons (jao-notmuch-gnus-message-id) - (gnus-summary-article-subject))))) - (org-link-store-props :type "mail" - :link (concat "mail:" (car d)) - :description (concat "Mail: " (cdr d))))) - -(org-link-set-parameters "mail" - :follow #'jao-notmuch-gnus-org-follow - :store #'jao-notmuch-gnus-org-store) - -(org-link-set-parameters "gnus" :store #'ignore) -(org-link-set-parameters "notmuch" :store #'ignore) - -;;; consult-notmuch - -(with-eval-after-load "consult-notmuch" - (defun jao-notmuch-gnus--open-candidate (candidate) - "Open a notmuch-search completion candidate email in Gnus." - (message "candidate: %S" candidate) - (jao-notmuch-gnus-goto-message (consult-notmuch--thread-id candidate))) - - (defun jao-gnus-consult-notmuch () - "Run a consult-notmuch query that opens candidates in Gnus." - (interactive) - (jao-notmuch-gnus--open-candidate (consult-notmuch--search))) - - (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) - -;;; . -(provide 'jao-notmuch-gnus) -;;; jao-notmuch-gnus.el ends here diff --git a/attic/net/jao-notmuch-move.el b/attic/net/jao-notmuch-move.el deleted file mode 100644 index eb7ea4c..0000000 --- a/attic/net/jao-notmuch-move.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; jao-notmuch-move.el --- Move messages around in notmuch -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 jao - -;; Author: jao -;; 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 . - -;;; Commentary: - -;; Moving messages around - -;;; Code: - -(require 'notmuch) - -(defvar jao-notmuch-mailboxes nil) -(defvar jao-notmuch-mailboxes-rx nil) - -(defun jao-notmuch--path-to-mailbox (full-path) - (unless jao-notmuch-mailboxes-rx - (setq jao-notmuch-mailboxes-rx (regexp-opt jao-notmuch-mailboxes))) - (if (string-match jao-notmuch-mailboxes-rx full-path) - (match-string 0 full-path) - (user-error "Message not in any registered mailbox!"))) - -(defun jao-notmuch--msg-props () - (if-let ((p (save-excursion - (beginning-of-line) - (text-property-search-forward :notmuch-message-properties)))) - (prop-match-value p) - (user-error "No message at point"))) - -(defun jao-notmuch--full-path () - (seq-find #'file-exists-p (plist-get (jao-notmuch--msg-props) :filename))) - -(defun jao-notmuch--move (&optional full-path d) - (let* ((full-path (or full-path (jao-notmuch--full-path))) - (ff (jao-notmuch--path-to-mailbox full-path)) - (d (or d (completing-read (format "From %s to: " ff) - (remove ff jao-notmuch-mailboxes) nil t))) - (dest (string-replace ff d full-path)) - (dest (replace-regexp-in-string ",U=.+$" "m:2,S" dest)) - (ftags (split-string ff "/")) - (ttags (split-string d "/"))) - (when (y-or-n-p (format "%s -> %s? " ftags ttags)) - (notmuch-tree-close-message-window) - (notmuch-tree-tag (append (notmuch-tag-change-list ftags t) - (notmuch-tag-change-list ttags))) - (rename-file (jao-notmuch--full-path) dest) - (shell-command-to-string "notmuch new") - (notmuch-refresh-this-buffer)))) - -(defun jao-notmuch-move-message () - "Move message at point to another folder." - (interactive) - (jao-notmuch--move)) - - - - -(provide 'jao-notmuch-move) -;;; jao-notmuch-move.el ends here diff --git a/attic/net/jao-notmuch-tree-fold.el b/attic/net/jao-notmuch-tree-fold.el deleted file mode 100644 index ef528df..0000000 --- a/attic/net/jao-notmuch-tree-fold.el +++ /dev/null @@ -1,139 +0,0 @@ -;;; jao-notmuch-tree-fold.el --- Show/hide (sub)tress in notmuch-tree -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 jao - -;; Author: jao -;; 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 . - -;;; Commentary: - -;; - -;;; Code: - -(require 'jao-notmuch) - - -;; Show/hide threads - -(defun jao-notmuch--tree-top () (notmuch-tree-get-prop :first)) - -(defun jao-notmuch--tree-bottom () - (let ((line-move-ignore-invisible t)) - (save-excursion - (when (zerop (forward-line 1)) - (or (not (notmuch-tree-get-message-properties)) - (jao-notmuch--tree-top)))))) - -(defun jao-notmuch-tree-hide-thread () - (interactive) - (notmuch-tree-thread-top) - (save-excursion - (forward-line 1) - (when (not (jao-notmuch--tree-top)) - (let ((line-move-ignore-invisible nil) - (inhibit-read-only t) - (p (point))) - (unless (notmuch-tree-next-thread-in-tree) - (forward-line -1)) - (add-text-properties p (point) '(invisible t)))))) - -(defun jao-notmuch-tree-show-thread () - (interactive) - (when (or (jao-notmuch--tree-top) (invisible-p (point))) - (let ((line-move-ignore-invisible nil)) - (notmuch-tree-thread-top) - (let ((inhibit-read-only t) - (p (point))) - (notmuch-tree-next-thread-in-tree) - (remove-text-properties p (point) '(invisible nil)) - (goto-char p))))) - -(defun jao-notmuch-tree-show-all () - (interactive) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'invisible nil))) - -(defun jao-notmuch-tree-hide-all () - (interactive) - (let ((inhibit-read-only t) - (line-move-ignore-invisible nil)) - (goto-char (point-min)) - (jao-notmuch-tree-hide-thread) - (while (notmuch-tree-next-thread-in-tree) - (jao-notmuch-tree-hide-thread))) - (goto-char (point-min))) - -(defun jao-notmuch-tree-toggle-thread () - (interactive) - (let ((line-move-ignore-invisible nil)) - (forward-line 1) - (when (jao-notmuch--tree-top) - (forward-line -1)) - (if (invisible-p (point)) - (jao-notmuch-tree-show-thread) - (jao-notmuch-tree-hide-thread)))) - -(defvar notmuch-tree-thread-map - (let ((m (make-keymap "Thread operations"))) - (define-key m (kbd "TAB") #'jao-notmuch-tree-toggle-thread) - (define-key m (kbd "t") #'jao-notmuch-tree-toggle-thread) - (define-key m (kbd "s") #'jao-notmuch-tree-show-thread) - (define-key m (kbd "S") #'jao-notmuch-tree-show-all) - (define-key m (kbd "h") #'jao-notmuch-tree-hide-thread) - (define-key m (kbd "H") #'jao-notmuch-tree-hide-all) - m)) - -(defun jao-notmuch--tree-next (prev thread no-exit) - (let ((line-move-ignore-invisible t)) - (cond ((looking-at-p "^End of search results") - (unless no-exit - (notmuch-tree-close-message-window) - (notmuch-tree-quit))) - ((jao-notmuch--looking-at-new-p) - (save-excursion (jao-notmuch-tree-show-thread)) - (notmuch-tree-show-message nil)) - (thread - (save-excursion (jao-notmuch-tree-hide-thread)) - (when (notmuch-tree-next-thread prev) - (save-excursion (jao-notmuch-tree-show-thread))) - (unless (jao-notmuch--looking-at-new-p) - (notmuch-tree-matching-message prev (not no-exit)))) - ((or (and (not prev) (jao-notmuch--tree-bottom)) - (and prev (jao-notmuch--tree-top))) - (save-excursion (jao-notmuch-tree-hide-thread)) - (forward-line (if prev -1 1)) - (jao-notmuch--tree-next prev nil no-exit)) - ((notmuch-tree-get-message-id) - (save-excursion (jao-notmuch-tree-show-thread)) - (notmuch-tree-matching-message prev (not no-exit))))) - (when (notmuch-tree-get-message-id) - (notmuch-tree-show-message nil)) - (jao-notmuch--tree-update-buffer-name)) - -(defun jao-notmuch-tree-next (thread &optional no-exit) - "Next message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch--tree-next nil thread no-exit)) - -(defun jao-notmuch-tree-previous (thread) - "Previous message or thread in forest, taking care of thread visibility.." - (interactive "P") - (jao-notmuch--tree-next t thread t)) - - -(provide 'jao-notmuch-tree-fold) -;;; jao-notmuch-tree-fold.el ends here diff --git a/attic/net/jao-proton-utils.el b/attic/net/jao-proton-utils.el deleted file mode 100644 index 012a2ff..0000000 --- a/attic/net/jao-proton-utils.el +++ /dev/null @@ -1,131 +0,0 @@ -;; jao-proton-utils.el -- simple interaction with Proton mail and vpn - -;; Copyright (c) 2018, 2019, 2020 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 -;; 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))) - -(defvar proton-vpn-mode-map) - -(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/attic/net/nnnm.el b/attic/net/nnnm.el deleted file mode 100644 index 552e95c..0000000 --- a/attic/net/nnnm.el +++ /dev/null @@ -1,265 +0,0 @@ -;;; nnnm.el --- Gnus backend for notmuch -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 jao - -;; Author: jao -;; 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 . - -;;; Commentary: - -;; A Gnus mail backend using notmuch. - -;;; Code: - -(require 'gnus) -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) - - -(nnoo-declare nnnm) - -(defvar nnnm-marks-to-tags '((tick . "flagged"))) - -(defvar nnnm-saved-searches nil) - -(defvar nnnm-maildir nil) - -(defvar nnnm--group-data nil) - -(defun nnnm--group-data (group) (cdr (assoc group nnnm--group-data))) - -(defun nnnm--set-group-data (group data) - (setf (alist-get group nnnm--group-data nil t #'string=) data)) - - -(defun nnnm--find-query (name) - (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name)) - nnnm-saved-searches)) - (plist-get s :query))) - -(defun nnnm--find-message-file (id) - (car (split-string - (shell-command-to-string - (format "notmuch search --output=files %s" - (if (string-prefix-p "id:" id) id (concat "id:" id))))))) - -(defun nnnm--article-data (article group) - (cond ((stringp article) (list article)) - ((numberp article) - (when-let (data (nnnm--group-data group)) - (elt data (1- article)))))) - -(defun nnnm-article-to-file (article group) - (when-let (d (nnnm--article-data article group)) - (or (cadr d) (nnnm--find-message-file (car d))))) - -(defun nnnm--count (query &optional context) - (let ((cmd (format "notmuch count -- '(%s)%s'" - query - (if context (concat " AND " context) "")))) - (string-to-number (shell-command-to-string cmd)))) - -(defun nnnm--search (query &optional context) - (let ((cmd (format "notmuch search --sort=oldest-first --output=messages -- %s%s" - (shell-quote-argument (format "(%s)" query)) - (if context (concat " AND " context) "")))) - (split-string (shell-command-to-string cmd)))) - -(defun nnnm--tag (query tags) - (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query))) - (shell-command-to-string cmd))) - -(defun nnnm--ids-query (ids) (mapconcat #'identity ids " OR ")) - -(defun nnnm--prefixed (group server) - (gnus-group-prefixed-name group `(nnnm ,server))) - -(defun nnnm--get-group-marks (group server) - (gnus-info-marks (gnus-get-info (nnnm--prefixed group server)))) - -(defun nnnm--set-group-marks (marks group server) - (let* ((full-group (nnnm--prefixed group server)) - (info (gnus-get-info full-group))) - (gnus-info-set-marks info marks) - (gnus-set-info full-group info))) - -(defun nnnm--subtract-from-ranges (ranges lst) - (let ((ranges (gnus-uncompress-sequence ranges))) - (dolist (n lst) - (let ((rs (seq-group-by (lambda (r) (> n r)) ranges))) - (setq ranges - (append (alist-get t rs) (mapcar #'1- (alist-get nil rs)))))) - (gnus-compress-sequence ranges))) - -(defun nnnm--remove-articles-from-marks (ranges group server) - (let ((marks (nnnm--get-group-marks group server)) - (lst (gnus-uncompress-sequence ranges)) - (new-marks)) - (dolist (m marks) - (push (cons (car m) (nnnm--subtract-from-ranges (cdr m))) lst)) - (nnnm--set-group-marks marks group server))) - -(defun nnnm--set-active (n group server) - (gnus-set-active (nnnm--prefixed group server) (cons 1 n))) - -(defun nnnm--update-group-data (group &optional server) - (when-let (query (nnnm--find-query group)) - (let* ((data (or (nnnm--group-data group) - (mapcar #'list (nnnm--search query "NOT tag:new")))) - (ids (nnnm--search query "tag:new")) - (nids (length ids)) - (new-data (mapcar (lambda (id) - (list id (nnnm--find-message-file id))) - ids))) - (when (> nids 0) - (nnnm--tag (nnnm--ids-query ids) "-new") - (nnheader-report 'nnnm "%s: %d new messages retrieved" group nids)) - (nnnm--set-group-data group (append data new-data)) - (nnnm--set-active (+ nids (length data)) group server) - (length ids)))) - - - -;;; Interface functions. - -(nnoo-define-basics nnnm) - -(defun nnnm-request-type (_group &optional _article) - 'mail) - -(deffoo nnnm-open-server (server &optional defs) - (nnoo-change-server 'nnnm server defs) - (setq nnnm--group-data nil) - (nnheader-report 'nnnm "Opened server %s" server) - t) - -(deffoo nnnm-close-server (_server) - (setq nnnm--group-data nil)) - -(deffoo nnnm-request-regenerate (_server) - (setq nnnm--group-data nil) - t) - -(deffoo nnnm-request-list (&optional _server) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (dolist (s nnnm-saved-searches) - (when-let (query (plist-get s :query)) - (let ((name (plist-get s :name)) - (total (nnnm--count query))) - (insert (format "%s %d 1 y\n" name total)))))) - t) - -(deffoo nnnm-retrieve-headers (sequence &optional group server _fetch-old) - (when (nnnm--update-group-data group server) - (with-current-buffer nntp-server-buffer - (delete-region (point-min) (point-max)) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (count -1)) - (if (stringp (car sequence)) - 'headers - (dolist (article sequence) - (when-let (file (nnnm-article-to-file article group)) - (insert (format "221 %d Article retrieved.\n" article)) - (save-excursion (nnheader-insert-head file)) - (if (re-search-forward "\n\r?\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max))) - (when (zerop (% (cl-incf count) 20)) - (nnheader-message 6 "nnnm: Receiving headers... %d%%" - (floor (* count 100.0) (length sequence))))) - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnnm-request-article (id &optional group _server buffer) - (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) - (file-name-coding-system nnmail-pathname-coding-system) - (d (nnnm--article-data id group)) - (id (car d)) - (file (when id (or (cadr d) (nnnm--find-message-file id))))) - (cond - ((not file) - (nnheader-report 'nnnm "No such article: %s" id)) - ((not (file-exists-p file)) - (nnheader-report 'nnnm "No such file: %s" file)) - ((not (save-excursion (nnmail-find-file file))) - (nnheader-report 'nnnm "Couldn't read file: %s" file)) - (t - (nnnm--tag id "-unread") - (nnheader-report 'nnnm "Article %s retrieved and tagged" id) - (cons group id))))) - -(deffoo nnnm-request-expire-articles (articles group &optional _server _force) - (let* ((articles (gnus-uncompress-range articles)) - (ids (mapcar (lambda (a) (car (nnnm--article-data a group))) articles))) - (when ids - (nnnm--tag (nnnm--ids-query ids) "+deleted") - (let ((data (nnnm--group-data group))) - (dolist (id ids) - (setq data - (cl-delete-if (lambda (d) (string= (car d) id)) data :count 1))) - (nnnm--set-group-data group data) - (nnnm--remove-articles-from-marks articles group server) - (nnnm--set-active (length data) group server))) - articles)) - -(deffoo nnnm-request-set-mark (group actions &optional _server) - (message "set marks: %s: %S" group actions) - actions) - -;; (deffoo nnnm-request-move-article -;; (article group server accept-form &optional last _move-is-internal) -;; (error "Not implemented yet")) - -(deffoo nnnm-request-group (group &optional server _dont-check info) - (nnheader-message 7 "nnnm: Opening %s -- %s" info group) - (if (nnnm--update-group-data group server) - (let ((n (length (nnnm--group-data group)))) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (nnheader-insert "211 %d %d %d %s\n" n 1 n group) - n)) - (nnheader-report 'nnnm "Invalid group"))) - -(deffoo nnnm-request-newgroups (_date &optional server) - (nnnm-request-list server)) - -(deffoo nnnm-request-group-scan (group &optional server _info) - (nnnm--set-group-data group nil) - (nnnm--update-group-data group server)) - -(deffoo nnnm-request-scan (&optional group server) - (if group - (nnnm--update-group-data group server) - (setq nnnm--group-data nil))) - -(deffoo nnnm-request-create-group (group &optional _server _args) - (let ((query (read-string "Query: "))) - (add-to-list 'nnnm-saved-searches `(:name ,group :query ,query)))) - -;; (deffoo nnnm-request-rename-group (group new-name &optional _server) -;; (error "Not implemented yet")) - -(deffoo nnnm-close-group (_group &optional _server) t) - - - -(provide 'nnnm) -;;; nnnm.el ends here diff --git a/attic/net/w3m.org b/attic/net/w3m.org deleted file mode 100644 index 3689c8e..0000000 --- a/attic/net/w3m.org +++ /dev/null @@ -1,191 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments no :results silent -#+title: Customizations for emacs-w3m -#+auto_tangle: t - -* browse-url and afio - #+begin_src emacs-lisp - (defun jao-w3m-find-url (url) - (let* ((url (w3m-canonicalize-url url)) - (fn `(lambda (b) - (with-current-buffer b - (string= ,url (w3m-canonicalize-url w3m-current-url)))))) - (when-let (b (seq-find fn (w3m-list-buffers))) - (pop-to-buffer b)))) - - (defun jao-w3m-browse-url (url &rest r) - (jao-afio--goto-www) - (select-window (frame-first-window)) - (or (jao-w3m-find-url url) - (w3m-goto-url-new-session url))) - - (defun jao-w3m-download (arg) - (interactive "P") - (jao-download (w3m-anchor) arg)) - - (setq jao-afio-use-w3m t) - (setq jao-browse-url-function 'jao-w3m-browse-url) - #+end_src -* Org integration - #+begin_src emacs-lisp - (defun jao-w3m-get-link () - (let ((wb (w3m-alive-p))) - (when wb - (let ((url (with-current-buffer wb w3m-current-url)) - (title (w3m-buffer-title wb))) - (cons url title))))) - - (defun jao-insert-w3m-link () - (interactive) - (let ((link (jao-w3m-get-link))) - (when link (insert "[[" (car link) "][" (cdr link) "]]")))) - - (with-eval-after-load "org" - (require 'ol-w3m nil t) - (define-key org-mode-map "\C-cW" 'jao-insert-w3m-link)) - #+end_src -* notmuch integration - #+begin_src emacs-lisp - (defvar-local jao-notmuch--showing-images nil) - - (defun jao-notmuch--setup-w3m-images (&optional activate) - (when (eq mm-text-html-renderer 'w3m) - (setq-local w3m-ignored-image-url-regexp - (unless jao-notmuch--showing-images - notmuch-show-text/html-blocked-images)) - (when activate - (setq-local scroll-margin 0) - (w3m-toggle-inline-images (if jao-notmuch--showing-images t 'turnoff))))) - - (defun jao-notmuch--w3m-toggle-images () - (save-window-excursion - (when (or (derived-mode-p 'notmuch-show-mode) - (jao-notmuch-goto-message-buffer nil t)) - (goto-char (point-min)) - (when (re-search-forward "^\\[ text/html " nil t) - (when (looking-at-p "(hidden)") - (notmuch-show-toggle-part-invisibility)) - (forward-line 1) - (setq jao-notmuch--showing-images (not jao-notmuch--showing-images)) - (jao-notmuch--setup-w3m-images t))))) - - (add-hook 'notmuch-show-mode-hook #'jao-notmuch--setup-w3m-images) - #+end_src -* Capture page - #+begin_src emacs-lisp - (defun jao-w3m-capture-page () - (interactive) - (let* ((title (w3m-current-title)) - (url w3m-current-url) - (html (y-or-n-p "Save as HTML (y) or PS (n)? ")) - (basename (concat (read-string "File name: ") - (if html ".html" ".ps"))) - (name (expand-file-name basename jao-sink-dir))) - (if html - (progn - (w3m-view-source) - (write-region (point-min) (point-max) name nil nil nil t) - (w3m-view-source)) - (progn - (split-window-horizontally 85) - (w3m-redisplay-this-page) - (ps-print-buffer name) - (delete-other-windows) - (w3m-redisplay-this-page))) - (kill-new (format "[[doc:%s][%s]] ([[%s][original]])" - basename title url)))) - #+end_src -* Consult narrowing - #+begin_src emacs-lisp - (with-eval-after-load "w3m-util" - (with-eval-after-load "consult" - (defvar jao-consult-w3m-buffer-history nil) - (defun jao-www--item (b) - (with-current-buffer b - (propertize (or w3m-current-title (buffer-name)) - 'buffer b - 'url (or w3m-current-url (buffer-name))))) - (defvar jao-consult-w3m-source - (list :name "www buffer" - :category 'www-buffer - :hidden t - :narrow (cons ?w "www") - :annotate (lambda (b) (when b (get-text-property 0 'url b))) - :history 'jao-consult-w3m-buffer-history - :items (lambda () - (seq-map #'jao-www--item - (seq-filter #'jao-www--buffer-p (buffer-list)))) - :action (lambda (b) - (jao-afio--goto-www) - (switch-to-buffer (get-text-property 0 'buffer b))))) - (jao-consult-add-buffer-source 'jao-consult-w3m-source "Web" ?w))) - #+end_src -* Package - #+begin_src emacs-lisp - (use-package w3m - :ensure t - :custom ((w3m-key-binding 'info) - (w3m-display-mode 'dual-pane)) - :init - (setq w3m-add-user-agent nil - w3m-confirm-leaving-secure-page nil - w3m-cookie-accept-bad-cookies t - w3m-cookie-accept-domains '(".github.com" - ".librarything.com" - ".goodreads.com" - ".sr.ht" - ".gnu.org" - ".codeberg.org" - "codeberg.org" - ".bookshop.org" - ".reddit.com") - w3m-cookie-reject-domains '(".") - w3m-default-save-directory "~/var/download" - w3m-do-cleanup-temp-files nil - w3m-external-view-temp-directory "/tmp" - w3m-fill-column 110 - w3m-goto-article-function 'jao-w3m-browse-url - w3m-form-input-textarea-buffer-lines 40 - w3m-history-minimize-in-new-session t - w3m-history-reuse-history-elements nil - w3m-image-no-idle-timer t - w3m-make-new-session t - w3m-profile-directory "~/.w3m" - w3m-redisplay-pages-automatically-p nil - w3m-resize-images t - w3m-safe-url-regexp nil - w3m-search-default-engine "duckduckgo" ; "google-en" - w3m-select-buffer-horizontal-window nil - w3m-select-buffer-window-ratio '(20 . 40) - w3m-session-load-last-sessions t - w3m-session-load-crashed-sessions 'ask - w3m-show-graphic-icons-in-header-line nil - w3m-show-graphic-icons-in-mode-line nil - w3m-use-tab nil - w3m-use-tab-line nil - w3m-use-title-buffer-name t - w3m-use-cookies t - w3m-use-filter nil - w3m-use-favicon nil - w3m-use-header-line nil - w3m-use-refresh nil - w3m-use-symbol t) - - :config - :bind (:map w3m-mode-map - (("+" . w3m-zoom-in-image) - ("-" . w3m-zoom-out-image) - ("C-c C-@" . tracking-next-buffer) - ("C-c C-SPC" . tracking-next-buffer) - ("C-c C-b" . nil) - ("C-c c" . jao-w3m-capture-page) - ("b" . w3m-view-previous-page) - ("B" . w3m-view-next-page) - ("c" . w3m-print-this-url) - ("d" . jao-w3m-download) - ("D" . w3m-download) - ("f" . w3m-lnum-follow) - ("v" . jao-view-video) - ("w" . org-w3m-copy-for-org-mode) - ("x" . jao-rss-subscribe) - ("y" . w3m-print-current-url)))) - #+end_src -- cgit v1.2.3