diff options
Diffstat (limited to 'attic/elisp')
| -rw-r--r-- | attic/elisp/jao-custom-modus.el | 159 | ||||
| -rw-r--r-- | attic/elisp/jao-emms-info-track.el | 214 | ||||
| -rw-r--r-- | attic/elisp/jao-emms-lyrics.el | 41 | ||||
| -rw-r--r-- | attic/elisp/jao-emms-random-album.el | 118 | ||||
| -rw-r--r-- | attic/elisp/jao-emms.el | 27 | ||||
| -rw-r--r-- | attic/elisp/jao-frm.el | 222 | ||||
| -rw-r--r-- | attic/elisp/jao-maildir.el | 189 | ||||
| -rw-r--r-- | attic/elisp/jao-mpdn.el | 133 | ||||
| -rw-r--r-- | attic/elisp/jao-notmuch-gnus.el | 226 | ||||
| -rw-r--r-- | attic/elisp/jao-notmuch-move.el | 75 | ||||
| -rw-r--r-- | attic/elisp/jao-notmuch-tree-fold.el | 139 | ||||
| -rw-r--r-- | attic/elisp/jao-proton-utils.el | 131 | ||||
| -rw-r--r-- | attic/elisp/jao-recoll.el | 131 | ||||
| -rw-r--r-- | attic/elisp/misc.el | 341 | ||||
| -rw-r--r-- | attic/elisp/nnnm.el | 265 |
15 files changed, 2411 insertions, 0 deletions
diff --git a/attic/elisp/jao-custom-modus.el b/attic/elisp/jao-custom-modus.el new file mode 100644 index 0000000..9b2cd8e --- /dev/null +++ b/attic/elisp/jao-custom-modus.el @@ -0,0 +1,159 @@ +;;; jao-custom-themes.el --- color themes based on modus-themes -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 jao + +;; Author: jao <mail@jao.io> +;; Keywords: faces, faces + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Color themes based on modus + +;;; Code: + +(use-package modus-themes + :ensure t + :demand t) + +;;;; Customization +(setq modus-themes-italic-constructs t + modus-themes-bold-constructs t + modus-themes-mixed-fonts nil + modus-themes-subtle-line-numbers t + modus-themes-intense-mouseovers nil + modus-themes-deuteranopia nil + modus-themes-tabs-accented t + modus-themes-variable-pitch-ui nil + modus-themes-inhibit-reload nil + + modus-themes-fringes nil ; {nil,'subtle,'intense} + + ;; Options for `modus-themes-lang-checkers' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `straight-underline', `text-also', `background', + ;; `intense' OR `faint'. + modus-themes-lang-checkers nil + + ;; Options for `modus-themes-mode-line' are either nil, or a list + ;; that can combine any of `3d' OR `moody', `borderless', + ;; `accented', a natural number for extra padding (or a cons cell + ;; of padding and NATNUM), and a floating point for the height of + ;; the text relative to the base font size (or a cons cell of + ;; height and FLOAT) + modus-themes-mode-line '(accented borderless) + + ;; Options for `modus-themes-markup' are either nil, or a list + ;; that can combine any of `bold', `italic', `background', + ;; `intense'. + modus-themes-markup '(background) + + ;; Options for `modus-themes-syntax' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `faint', `yellow-comments', `green-strings', `alt-syntax' + modus-themes-syntax '(faint alt-syntax) + + ;; Options for `modus-themes-hl-line' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `accented', `underline', `intense' + modus-themes-hl-line nil + + ;; Options for `modus-themes-paren-match' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `bold', `intense', `underline' + modus-themes-paren-match '(bold) + + ;; Options for `modus-themes-links' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `neutral-underline' OR `no-underline', `faint' OR `no-color', + ;; `bold', `italic', `background' + modus-themes-links '(neutral-underline) + + ;; Options for `modus-themes-box-buttons' are either nil (the + ;; default), or a list that can combine any of `flat', + ;; `accented', `faint', `variable-pitch', `underline', + ;; `all-buttons', the symbol of any font weight as listed in + ;; `modus-themes-weights', and a floating point number + ;; (e.g. 0.9) for the height of the button's text. + modus-themes-box-buttons '(flat) + + ;; Options for `modus-themes-prompts' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `background', `bold', `gray', `intense', `italic' + modus-themes-prompts nil + + ;; The `modus-themes-completions' is an alist that reads three + ;; keys: `matches', `selection', `popup'. Each accepts a nil + ;; value (or empty list) or a list of properties that can include + ;; any of the following (for WEIGHT read further below): + ;; + ;; `matches' - `background', `intense', `underline', `italic', WEIGHT + ;; `selection' - `accented', `intense', `underline', `italic', `text-also', WEIGHT + ;; `popup' - same as `selected' + ;; `t' - applies to any key not explicitly referenced (check docs) + ;; + ;; WEIGHT is a symbol such as `semibold', `light', or anything + ;; covered in `modus-themes-weights'. Bold is used in the absence + ;; of an explicit WEIGHT. + modus-themes-completions + '((matches . (regular)) + (selection . (regular accented)) + (popup . (regular accented))) + + modus-themes-mail-citations '(faint) ; {nil,'intense,'faint,'monochrome} + + ;; Options for `modus-themes-region' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `no-extend', `bg-only', `accented' + modus-themes-region nil + + ;; Options for `modus-themes-diffs': nil, 'desaturated, 'bg-only + modus-themes-diffs 'desaturated + + modus-themes-org-blocks nil ; {nil,'gray-background,'tinted-background} + + modus-themes-org-agenda ; this is an alist: read the manual or its doc string + '((header-block . (light 1.0)) + (header-date . (underline-today grayscale workaholic 1.0)) + (event . (accented italic varied)) + (scheduled . rainbow) + (habit . simplified)) + + ;; The `modus-themes-headings' is an alist with lots of possible + ;; combinations, include per-heading-level tweaks: read the + ;; manual or its doc string + modus-themes-headings + '((0 . (light)) + (1 . (rainbow light)) + (2 . (rainbow light)) + (3 . (rainbow regular)) + (4 . (rainbow regular)) + (5 . (rainbow)) + (t . (semibold)))) + +;;;; Loading themes +(modus-themes-load-themes) + +(defun jao-colors-scheme-dark-p () + (equal "dark" (getenv "JAO_COLOR_SCHEME"))) + +(if (jao-colors-scheme-dark-p) + (modus-themes-load-vivendi) + (modus-themes-load-operandi)) + +;; (jao-mode-line-adjust-faces) + +(provide 'jao-custom-themes) +;;; jao-custom-themes.el ends here diff --git a/attic/elisp/jao-emms-info-track.el b/attic/elisp/jao-emms-info-track.el new file mode 100644 index 0000000..cf93625 --- /dev/null +++ b/attic/elisp/jao-emms-info-track.el @@ -0,0 +1,214 @@ +;; jao-emms-info-track.el -- utilities to show tracks -*- lexical-binding:t; -*- + +;; Copyright (C) 2009, 2010, 2013, 2017, 2020, 2021 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sat Jul 04, 2009 13:47 + +;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'emms) +(require 'emms-tag-editor) +(require 'emms-player-mpd) +(require 'jao-emms) +(require 'jao-minibuffer) + +(defgroup jao-emms-faces nil "Faces" + :group 'faces + :group 'jao-emms) + +(defface jao-emms-font-lock-album '((t (:foreground "lightgoldenrod2"))) + "Album name in EMMS track message." + :group 'jao-emms-faces) + +(defface jao-emms-font-lock-track '((t (:bold t))) + "Track number in EMMS track message." + :group 'jao-emms-faces) + +(defface jao-emms-font-lock-title '((t (:foreground "dodgerblue2"))) + "Track title in EMMS track message." + :group 'jao-emms-faces) + +(defface jao-emms-font-lock-artist '((t (:foreground "dodgerblue3"))) + "Artist name in EMMS track message." + :group 'jao-emms-faces) + +(defcustom jao-emms-show-osd-p nil + "Whether to show osd notices on track change" + :group 'jao-emms) + + + +(defun jao-emms-info-track-stream (track) + "Return track info for streams" + (let* ((name (emms-track-name track)) + (title (or (emms-track-get track 'title nil) + (car (emms-track-get track 'metadata nil)) + (car (split-string (shell-command-to-string "mpc status") + "\n")))) + (title (if (string-match "https?://\\([^/]+\\)/.+" (or title "")) + (match-string 1 title) + title))) + (format " %s (%s)" (or title "") (if title (emms-track-type track) name)))) + +(defsubst jao--put-face (str face) + (put-text-property 0 (length str) 'face face str) + str) + +(defun jao-emms--to-number (x) + (or (and (numberp x) x) + (and (stringp x) + (string-match "\\`\\(:?[0-9]+\\)" x) + (string-to-number (match-string 1 x))))) + +(defun jao-emms--fmt-time (x suffix) + (if x (format "%02d:%02d%s" (/ x 60) (mod x 60) (or suffix "")) "")) + +(defun jao-emms--fmt-song-times (track lapsed pre post) + (if lapsed + (let ((time (when track (emms-track-get track 'info-playing-time)))) + (format "%s%s%s%s" + (or pre "") + (jao-emms--fmt-time lapsed (when time "/")) + (jao-emms--fmt-time time "") + (or post ""))) + "")) + +(defun jao-emms-info-track-file (track &optional lapsed plen titlesep) + "Return a description of the current track." + (let* ((no (jao-emms--to-number (emms-track-get track 'info-tracknumber "0"))) + (time (emms-track-get track 'info-playing-time)) + (year (emms-track-get track 'info-year)) + (year (if year (format " (%s)" year) "")) + (artist (emms-track-get track 'info-artist "")) + (composer (emms-track-get track 'info-composer nil)) + (title (emms-track-get track 'info-title "")) + (album (emms-track-get track 'info-album)) + (last-played (or (emms-track-get track 'last-played) '(0 0 0))) + (play-count (or (emms-track-get track 'play-count) 0)) + (playlength (if plen (format "/%02d" (string-to-number plen)) ""))) + (if (or (not title) (not album)) + (emms-track-simple-description track) + (format " %s%s%s%s%s%s%s" + (jao--put-face (if (zerop no) "" (format "%02d%s " no playlength)) + 'jao-emms-font-lock-track) + (jao--put-face title + 'jao-emms-font-lock-title) + (or titlesep " ") + (jao-emms--fmt-song-times track lapsed "[" "] ") + (jao--put-face artist 'jao-emms-font-lock-artist) + (jao--put-face (if composer (format " [%s]" composer) "") + 'jao-emms-font-lock-artist) + (jao--put-face (if album + (format " (%s%s)" album year) + (format "%s *") year) + 'jao-emms-font-lock-album))))) + +;;;###autoload +(defun jao-emms-info-track-description (track &optional lapsed plen tsep) + (if (memq (emms-track-type track) '(streamlist url)) + (jao-emms-info-track-stream track) + (jao-emms-info-track-file track lapsed plen tsep))) + +;;;###autoload +(defun jao-emms-toggle-osd () + (interactive) + (setq jao-emms-show-osd-p (not jao-emms-show-osd-p)) + (message "Emms OSD %s" (if jao-emms-show-osd-p "enabled" "disabled"))) + +(defvar jao-emms-show-icon nil) + +(defun jao-emms--with-mpd-track (callback) + (emms-player-mpd-get-status + nil + (lambda (_ st) + (let* ((lapsed (jao-emms--to-number (cdr (assoc "time" st)))) + (plen (cdr (assoc "playlistlength" st))) + (song (jao-emms--to-number (cdr (assoc "song" st)))) + (track (emms-playlist-current-selected-track))) + (when (and track song) + (emms-track-set track 'info-tracknumber (format "%d" (1+ song)))) + (funcall callback track lapsed plen))))) + +;;;###autoload +(defun jao-emms-show-osd () + (interactive) + (jao-emms--with-mpd-track + (lambda (track lapsed play-len) + (let* ((sep "~~~~~") + (s (jao-emms-info-track-description track lapsed play-len sep)) + (s (substring-no-properties s 2)) + (cs (split-string s sep))) + (jao-notify (car cs) (cadr cs) jao-emms-show-icon))))) + +(defun jao-emms-show-osd-hook () + (interactive) + (when jao-emms-show-osd-p (jao-emms-show-osd))) + +(defun jao-emms-install-id3v2 () + (add-to-list 'emms-tag-editor-tagfile-functions + '("mp3" "id3v2" ((info-artist . "-a") + (info-title . "-t") + (info-album . "-A") + (info-tracknumber . "-T") + (info-year . "-y") + (info-genre . "-g") + (info-composer . "--TCOM") + (info-note . "-c"))))) + +(defvar jao-emms-echo-string "") + +(defun jao-emms--echo-string (v) + (setq jao-emms-echo-string v) + (jao-minibuffer-refresh)) + +(defun jao-emms-update-echo-string (&optional existing-track) + (if emms-player-playing-p + (jao-emms--with-mpd-track + (lambda (track lapsed play-len) + (jao-emms--echo-string + (cond ((and emms-player-paused-p existing-track) + (format "(%s/%s)" + (emms-track-get existing-track 'info-tracknumber) + play-len)) + (emms-player-paused-p "") + (t (jao-emms-info-track-description track nil play-len)))))) + (jao-emms--echo-string ""))) + +(defun jao-emms-enable-minibuffer (minibuffer-order) + (jao-minibuffer-add-msg-variable 'jao-emms-echo-string minibuffer-order) + (dolist (h '(emms-track-updated-functions + emms-player-finished-hook + emms-player-stopped-hook + emms-player-started-hook + emms-player-paused-hook)) + (add-hook h #'jao-emms-update-echo-string))) + +;;;###autoload +(defun jao-emms-info-setup (&optional minibuffer show-osd show-echo-line id3) + (setq emms-track-description-function 'jao-emms-info-track-description) + (setq jao-emms-show-osd-p show-osd) + (add-hook 'emms-player-started-hook 'jao-emms-show-osd-hook) + (when minibuffer (jao-emms-enable-minibuffer minibuffer)) + (unless show-echo-line + (eval-after-load 'emms-player-mpd + '(remove-hook 'emms-player-started-hook 'emms-player-mpd-show))) + (when id3 (jao-emms-install-id3v2)) + (ignore-errors (emms-player-mpd-connect))) + + +(provide 'jao-emms-info-track) +;;; jao-emms-info-track.el ends here diff --git a/attic/elisp/jao-emms-lyrics.el b/attic/elisp/jao-emms-lyrics.el new file mode 100644 index 0000000..0ea52e0 --- /dev/null +++ b/attic/elisp/jao-emms-lyrics.el @@ -0,0 +1,41 @@ +;; jao-emms-lyrics.el -- simple show lyrics in emms + +;; Copyright (C) 2009, 2010, 2017, 2019, 2020 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sat Jul 04, 2009 13:41 + +;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'emms) +(require 'jao-lyrics) + +;;;###autoload +(defun jao-emms-lyrics-track-data () + (let ((track (or (emms-playlist-current-selected-track) + (error "No playing track")))) + (cons (or (emms-track-get track 'info-artist nil) + (error "No artist")) + (or (emms-track-get track 'info-title nil) + (error "No artist"))))) + +;;;###autoload +(defun jao-emms-show-lyrics (&optional force) + (let ((jao-lyrics-info-function 'jao-emms-lyrics-track-data)) + (jao-show-lyrics force))) + +(provide 'jao-emms-lyrics) +;;; jao-emms-lyrics.el ends here diff --git a/attic/elisp/jao-emms-random-album.el b/attic/elisp/jao-emms-random-album.el new file mode 100644 index 0000000..72e056b --- /dev/null +++ b/attic/elisp/jao-emms-random-album.el @@ -0,0 +1,118 @@ +;; jao-emms-random-album.el -- play random albums in emms + +;; Copyright (C) 2009, 2010, 2017, 2018, 2020 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sat Jul 04, 2009 13:06 + +;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>. + + +(require 'emms) +(require 'jao-minibuffer) + +(defvar jao-emms-random-album-p t) +(defvar jao-emms-random-lines nil) +(defvar jao-emms-random-lines-file + (expand-file-name "~/.emacs.d/random-lines")) +(defvar jao-emms-random-album-notify-p t) +(defvar jao-emms-random-album-notify-icon nil) + +(defun jao-emms-random-lines () + (or jao-emms-random-lines + (and (file-exists-p jao-emms-random-lines-file) + (with-current-buffer + (find-file-noselect jao-emms-random-lines-file) + (goto-char (point-min)) + (setq jao-emms-random-lines (read (current-buffer))))) + (dotimes (n (1- (line-number-at-pos (point-max))) + jao-emms-random-lines) + (push (1+ n) jao-emms-random-lines)))) + +(defun jao-emms-random-lines-save () + (with-current-buffer (find-file-noselect jao-emms-random-lines-file) + (delete-region (point-min) (point-max)) + (insert (format "%s\n" jao-emms-random-lines)) + (save-buffer))) + +(defun jao-emms-goto-random-album () + (let* ((pos (random (length (jao-emms-random-lines)))) + (line (nth pos jao-emms-random-lines))) + (setq jao-emms-random-lines (remove line jao-emms-random-lines)) + (jao-emms-random-lines-save) + (goto-line line))) + +(defun jao-emms-next-noerror () + (interactive) + (when emms-player-playing-p + (error "A track is already being played")) + (cond (emms-repeat-track + (emms-start)) + ((condition-case nil + (progn + (emms-playlist-current-select-next) + t) + (error nil)) + (emms-start)) + (t + (if jao-emms-random-album-p + (jao-emms-random-album-next) + (message "No next track in playlist"))))) + + +;; User interface +;;;###autoload +(defun jao-emms-random-album-start () + (interactive) + (setq jao-emms-random-album-p t) + (jao-emms-random-album-next)) + +;;;###autoload +(defun jao-emms-random-album-stop () + (interactive) + (setq jao-emms-random-album-p nil) + (emms-stop)) + +;;;###autoload +(defun jao-emms-random-album-toggle () + (interactive) + (setq jao-emms-random-album-p (not jao-emms-random-album-p)) + (message "Random album %s" + (if jao-emms-random-album-p "enabled" "disabled"))) + +;;;###autoload +(defun jao-emms-random-album-next () + (interactive) + (save-excursion + (ignore-errors (emms-browser-clear-playlist)) + (emms-browse-by-album) + (jao-emms-goto-random-album) + (let ((album (substring-no-properties (thing-at-point 'line) 0 -1))) + (emms-browser-add-tracks-and-play) + (when jao-emms-random-album-notify-p + (jao-notify album "Next album" jao-emms-random-album-notify-icon))) + (emms-browser-bury-buffer) + (jao-minibuffer-refresh))) + +;;;###autoload +(defun jao-emms-random-album-reset () + (interactive) + (setq jao-emms-random-lines nil) + (jao-emms-random-lines-save)) + +(setq emms-player-next-function 'jao-emms-next-noerror) + + +(provide 'jao-emms-random-album) +;;; jao-emms-random-album.el ends here diff --git a/attic/elisp/jao-emms.el b/attic/elisp/jao-emms.el new file mode 100644 index 0000000..53b3513 --- /dev/null +++ b/attic/elisp/jao-emms.el @@ -0,0 +1,27 @@ +;; jao-emms.el -- shared bits + +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sat Jul 04, 2009 13:51 + +;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(defgroup jao-emms nil "Emms extensions" :group 'emms) + + +(provide 'jao-emms) +;;; jao-emms.el ends here diff --git a/attic/elisp/jao-frm.el b/attic/elisp/jao-frm.el new file mode 100644 index 0000000..2658687 --- /dev/null +++ b/attic/elisp/jao-frm.el @@ -0,0 +1,222 @@ +;;; jao-frm.el --- use frm to show mailbox + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2019, 2020 + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; 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/elisp/jao-maildir.el b/attic/elisp/jao-maildir.el new file mode 100644 index 0000000..18a1725 --- /dev/null +++ b/attic/elisp/jao-maildir.el @@ -0,0 +1,189 @@ +;; jao-maildir.el -- Utilities for reading maildirs -*- lexical-binding: t; -*- + +;; Copyright (c) 2019, 2020, 2021 jao + +;; Author: jao <mail@jao.io> +;; 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/elisp/jao-mpdn.el b/attic/elisp/jao-mpdn.el new file mode 100644 index 0000000..d707767 --- /dev/null +++ b/attic/elisp/jao-mpdn.el @@ -0,0 +1,133 @@ +;;; jao-mpdn.el --- Notifications using elmpd -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 jao + +;; Author: jao <mail@jao.io> +;; Keywords: convenience +;; Version: 0.1 +;; Package-requires: ((emacs "27.1") (elmpd "0.1.9")) +;; URL: https://codeberg.org/jao/lib/media + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; React to mpd player status changes. + +;;; Code: + +(require 'elmpd) +(require 'jao-minibuffer) + +(defvar jao-mpdn--connection nil) +(defvar jao-mpdn-host "localhost") +(defvar jao-mpdn-port 6600) +(defvar-local jao-mpdn--local-port nil) + +(defun jao-mpdn--disconnect (conn) + (delete-process (elmpd-connection--fd conn))) + +(defun jao-mpdn--connect (name &optional cb) + (elmpd-connect :name name + :host jao-mpdn-host + :port jao-mpdn-port + :subsystems + (when cb `((player) . ,cb)))) + +(defun jao-mpdn-disconnect () + (interactive) + (when jao-mpdn--connection + (jao-mpdn--disconnect jao-mpdn--connection) + (setq jao-mpdn--connection nil))) + +(defun jao-mpdn-connect (&optional force) + (interactive) + (when force (jao-mpdn-disconnect)) + (unless jao-mpdn--connection + (setq jao-mpdn--connection (jao-mpdn--connect "jao-mpc" 'jao-mpdn--watcher)) + (jao-mpdn--watcher jao-mpdn--connection 'player)) + jao-mpdn--connection) + +(defun jao-mpdn--send (cmd cb) + (elmpd-send jao-mpdn--connection cmd cb)) + +(defvar jao-mpdn--play-status '()) +(defvar jao-mpdn--current '()) +(defvar jao-mpdn-minibuffer-str "") + +(defun jao-mpdn--parse-retort (txt) + (let (res) + (dolist (e (split-string txt "\n" t " ") res) + (let ((e (split-string e ": " t " "))) + (when (and (car e) (cadr e)) + (push (cons (car e) (cadr e)) res)))))) + +(defun jao-mpdn--update-status (next) + (let ((cb (lambda (_c ok txt) + (when ok + (setq jao-mpdn--play-status (jao-mpdn--parse-retort txt)) + (when next (funcall next)))))) + (jao-mpdn--send "status" cb))) + +(defun jao-mpdn--current-get (x &optional def) + (alist-get x jao-mpdn--current def nil #'string=)) + +(defun jao-mpdn--status-get (x &optional def) + (alist-get x jao-mpdn--play-status def nil #'string=)) + +(defun jao-mpdn--playing-p () + (string= (jao-mpdn--status-get "state" "") "play")) + +(defun jao-mpdn--current-str () + (let ((title (jao-mpdn--current-get "Title")) + (album (jao-mpdn--current-get "Album")) + (no (string-to-number (jao-mpdn--current-get "Track" "0"))) + (len (string-to-number (jao-mpdn--status-get "playlistlength" "1"))) + (artist (jao-mpdn--current-get "Artist")) + (composer (jao-mpdn--current-get "Composer"))) + (format " %s%s %s%s%s" + (jao--put-face (if (zerop no) "" (format "%02d/%s " no len)) + 'jao-themes-f02) + (jao--put-face title 'jao-themes-f00) + (jao--put-face artist 'jao-themes-f01) + (jao--put-face (if composer (format " [%s]" composer) "") + 'jao-themes-f01) + (jao--put-face (if album (format " (%s)" album) "") 'jao-themes-f11)))) + +(defun jao-mpdn--update-minibuffer () + (setq jao-mpdn-minibuffer-str + (if (jao-mpdn--playing-p) (jao-mpdn--current-str) "")) + (jao-minibuffer-refresh)) + +(defun jao-mpdn--update-current (&optional next) + (let ((cb (lambda (_c ok txt) + (when ok + (setq jao-mpdn--current (jao-mpdn--parse-retort txt)) + (jao-mpdn--update-minibuffer) + (cond (next (funcall next)) + ((and (null jao-mpdn--current) jao-random-album-p) + (jao-random-album-next))))))) + (jao-mpdn--send "currentsong" cb))) + +(defun jao-mpdn--watcher (_conn _subsys) + (jao-mpdn--update-status #'jao-mpdn--update-current)) + + +;;;###autoload +(defun jao-mpdn-setup () + (jao-mpdn-connect t) + (jao-minibuffer-add-msg-variable 'jao-mpdn-minibuffer-str 1)) + +(provide 'jao-mpdn) +;;; jao-mpdn.el ends here diff --git a/attic/elisp/jao-notmuch-gnus.el b/attic/elisp/jao-notmuch-gnus.el new file mode 100644 index 0000000..1576964 --- /dev/null +++ b/attic/elisp/jao-notmuch-gnus.el @@ -0,0 +1,226 @@ +;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 jao + +;; Author: jao <mail@jao.io> +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Helper functions to work in Gnus with mail indexed by notmuch. + +;;; Code: + +(require 'gnus) +(require 'ol-gnus) +(require 'notmuch-show) + +;;; Tagging in notmuch from Gnus buffers + +(defun jao-notmuch-gnus--notmuch-id (id) + (when id (if (string-match "<\\(.+\\)>" id) (match-string 1 id) id))) + +(defun jao-notmuch-gnus-message-id (&optional no-show) + "Find the id of currently selected message in Gnus or notmuch." + (when (and (not no-show) (derived-mode-p 'gnus-summary-mode)) + (save-window-excursion (gnus-summary-show-article))) + (cond (gnus-original-article-buffer + (with-current-buffer gnus-original-article-buffer + (jao-notmuch-gnus--notmuch-id (message-field-value "message-id")))) + ((derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) + (notmuch-show-get-message-id)))) + +(defun jao-notmuch-gnus-message-tags (id) + "Ask notmuch for the tags of a message with the given ID." + (let ((cmd (format "notmuch search --output=tags 'id:%s'" id))) + (split-string (shell-command-to-string cmd)))) + +(defun jao-notmuch-gnus-tag-message (&optional id tags no-log) + "Interactively add or remove tags to the current message." + (interactive) + (let* ((id (or id (jao-notmuch-gnus-message-id))) + (current (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/elisp/jao-notmuch-move.el b/attic/elisp/jao-notmuch-move.el new file mode 100644 index 0000000..eb7ea4c --- /dev/null +++ b/attic/elisp/jao-notmuch-move.el @@ -0,0 +1,75 @@ +;;; jao-notmuch-move.el --- Move messages around in notmuch -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 jao + +;; Author: jao <mail@jao.io> +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; 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/elisp/jao-notmuch-tree-fold.el b/attic/elisp/jao-notmuch-tree-fold.el new file mode 100644 index 0000000..ef528df --- /dev/null +++ b/attic/elisp/jao-notmuch-tree-fold.el @@ -0,0 +1,139 @@ +;;; jao-notmuch-tree-fold.el --- Show/hide (sub)tress in notmuch-tree -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 jao + +;; Author: jao <mail@jao.io> +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; 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/elisp/jao-proton-utils.el b/attic/elisp/jao-proton-utils.el new file mode 100644 index 0000000..012a2ff --- /dev/null +++ b/attic/elisp/jao-proton-utils.el @@ -0,0 +1,131 @@ +;; 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 <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))) + +(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/elisp/jao-recoll.el b/attic/elisp/jao-recoll.el new file mode 100644 index 0000000..b23106f --- /dev/null +++ b/attic/elisp/jao-recoll.el @@ -0,0 +1,131 @@ +;;; jao-recoll.el -- Displaying recoll queries -*- lexical-binding: t; -*- + +;; Copyright (c) 2017, 2020, 2021, 2022 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Wed Nov 01, 2017 18:14 + + +;;; Comentary: + +;; A simple interactive command to perform recoll queries and display +;; its results using org markup. + +;;; Code: + +(require 'org) + +(define-derived-mode recoll-mode org-mode "Recoll" + "Simple mode for showing recoll query results" + (read-only-mode 1)) + +(defvar jao-recoll--file-regexp + "\\(\\w+/.+\\)\t+\\[\\([^]]+\\)\\]\t+\\[\\([^\t]+\\)\\].+") + +(defvar jao-recoll-flags "-A -p 5 -n 100") + +(defvar jao-recoll-single-buffer t) +(defvar-local jao-recoll--last-query nil) +(defvar-local jao-recoll--last-full-query nil) + +(defun jao-recoll-show-query () + (interactive) + (message (concat jao-recoll--last-query "\n" + jao-recoll--last-full-query))) + +(defun jao-recoll-requery () + (interactive) + (jao-recoll jao-recoll--last-query)) + +(defun jao-recoll--buffer (q) + (get-buffer-create (if jao-recoll-single-buffer + "*Recoll*" + (format "*Recoll: '%s'*" q)))) + +(defun jao-recoll--format-snippets (lnk) + (when (looking-at-p "SNIPPETS") + (let ((kill-whole-line t)) + (kill-line) + (while (and (not (eobp)) (not (looking-at-p "/SNIPPETS"))) + (cond ((looking-at "^\\([1-9][0-9]*\\) : ") + (replace-match (format " - [[%s::\\1][\\1]] : " lnk))) + ((looking-at "^0 : \\(.[^\n]+\\)") + (let ((desc (match-string 1))) + (replace-match " - ") + (insert (org-make-link-string lnk desc)))) + (t (insert " - "))) + (forward-line 1)) + (unless (eobp) (kill-line))))) + +(defun jao-recoll--org-link (uri desc mime) + (cond ((string= mime "application/pdf") + (concat "doc:" (file-name-nondirectory uri))) + ((string= mime "message/rfc822") (concat "message:" (substring uri 7))) + ((string= mime "text/x-orgmode-sub") (concat uri "::*" desc)) + (t uri))) + +;;;###autoload +(defun jao-recoll (&optional prefix-query) + "Performs a query using recoll and shows the results using org markup." + (interactive) + (let* ((query (read-string "Recoll query: " prefix-query)) + (cmd (format "recoll %s -t %s" + jao-recoll-flags (shell-quote-argument query))) + (inhibit-read-only t)) + (with-current-buffer (jao-recoll--buffer query) + (recoll-mode) + (delete-region (point-min) (point-max)) + (shell-command cmd t) + (setq jao-recoll--last-query query) + (goto-char (point-min)) + (when (looking-at-p "Recoll query:") + (setq jao-recoll--last-full-query + (string-trim (thing-at-point 'line))) + (let ((kill-whole-line nil)) (kill-line)) + (insert query) + (forward-line 2)) + (open-line 1) + (while (search-forward-regexp jao-recoll--file-regexp nil t) + (let* ((mime (match-string 1)) + (ref (match-string 2)) + (desc (match-string 3)) + (start (match-beginning 0)) + (end (match-end 0)) + (lnk (jao-recoll--org-link ref desc mime)) + (desc (if (string= mime "text/x-orgmode-sub") + (org-link-display-format + (concat (file-name-nondirectory ref) " :: " desc)) + desc))) + (delete-region start end) + (insert "* " (org-make-link-string lnk desc) " (" mime ")") + (forward-line) + (jao-recoll--format-snippets lnk))) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (org-next-visible-heading 1) + (org-overview) + (jao-recoll-show-query)))) + +(define-key recoll-mode-map [?n] 'org-next-link) +(define-key recoll-mode-map [?p] 'org-previous-link) +(define-key recoll-mode-map [?q] 'bury-buffer) +(define-key recoll-mode-map [?r] 'jao-recoll-requery) +(define-key recoll-mode-map [?g] 'jao-recoll-requery) +(define-key recoll-mode-map [?w] 'jao-recoll-show-query) + +;;; . +(provide 'jao-recoll) +;;; jao-recoll.el ends here diff --git a/attic/elisp/misc.el b/attic/elisp/misc.el new file mode 100644 index 0000000..d448ae7 --- /dev/null +++ b/attic/elisp/misc.el @@ -0,0 +1,341 @@ +;;; -*- lexical-binding: t; -*- + +;;; ace window +(use-package ace-window + :ensure t + :demand t + :init (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) + aw-char-position 'top-left + aw-ignore-current nil + aw-dispatch-when-more-than 2 + aw-leading-char-style 'path + aw-display-mode-overlay t + aw-scope 'frame) + :config + + (defun jao-ace-consult-buffer-other-window (w) + (interactive) + (aw-switch-to-window w) + (consult-buffer)) + + (setf (alist-get ?b aw-dispatch-alist) + '(jao-ace-consult-buffer-other-window "Consult buffer")) + + (setf (alist-get ?B aw-dispatch-alist) + (alist-get ?u aw-dispatch-alist)) + + + :bind (("M-o" . ace-window) + ("M-O" . ace-swap-window) + ("C-x 4 t" . ace-swap-window))) + +;;; deft +(use-package deft + :ensure t + :after jao-org-notes + :commands deft + :init (setq deft-extensions '("org" "md") + deft-directory jao-org-notes-dir + deft-use-filename-as-title nil + deft-use-filter-string-for-name t + deft-file-naming-rules '((noslash . "-") + (nospace . "-") + (case-fn . downcase)) + deft-org-mode-title-prefix t + deft-recursive t + deft-recursive-ignore-dir-regexp (regexp-opt '("." ".." "attic")) + deft-strip-summary-regexp + (concat "\\([\n\t]" + "\\|^#\\+\\(title\\|created\\|date\\|author\\):.*$" + "\\|^#\\+\\(file\\)?tags: *\\)")) + :config (setq deft-strip-title-regexp + (concat "\\(^#\\+title: *\\)\\|" deft-strip-title-regexp)) + :bind (("<f9>" . deft))) + +;;; detached +(use-package detached + :ensure t + :init + (detached-init) + :config + (transient-define-prefix jao-transient-detached () + ["Detached sessions" + ("v" "view session output" detached-view-session) + ("a" "attach to a session" detached-attach-session) + ("=" "diff a session with another session" detached-diff-session) + ("c" "open the session output in compilation mode" detached-compile-session) + ("r" "rerun a session" detached-rerun-session) + ("i" "insert the session's command at point" detached-insert-session-command) + ("w" "copy the session's shell command" detached-copy-session-command) + ("W" "copy the session's output" detached-copy-session) + ("k" "kill an active session" detached-kill-session)]) + + :bind (;; Replace `async-shell-command' with `detached-shell-command' + ([remap async-shell-command] . detached-shell-command) + ;; Replace `compile' with `detached-compile' + ([remap compile] . detached-compile) + ([remap recompile] . detached-compile-recompile) + ;; Replace built in completion of sessions with `consult' + ([remap detached-open-session] . detached-consult-session) + ("s-d" . jao-transient-detached)) + :custom ((detached-show-output-on-attach t) + (detached-terminal-data-command system-type))) + +(defun jao-detached-exec (command) + (if (fboundp 'detached-create-session) + (detached-create-session command) + (jao-shell-exec command))) + +;;; time display +(setq display-time-world-list + '(("Europe/Paris" "Barcelona") + ("America/Los_Angeles" "Los Angeles") + ("America/New_York" "New York") + ("Europe/London" "London") + ("Asia/Calcutta" "Bangalore") + ("Asia/Tokyo" "Tokyo"))) + +(defun jao-time--pdt-hour () + (jao-time-at-zone "%H" "America/Los_Angeles")) + +(defun jao-time--chicago-hour () + (jao-time-at-zone "%H" "America/Chicago")) + +(defun jao-time-at-zone (format zone) + (set-time-zone-rule zone) + (prog1 (format-time-string format) + (set-time-zone-rule nil))) + +(defun jao-time-echo-la-time () + (interactive) + (message (jao-time-at-zone "LA %H:%M" "America/Los_Angeles"))) + +(defun jao-time-echo-times () + (interactive) + (let ((msg (format "%s (%s)" + (format-time-string "%a, %e %B - %H:%M") + (jao-time-at-zone "%H:%M" "America/Los_Angeles")))) + (jao-notify msg "" (jao-data-file "clock-world-icon.png")))) + +(defun jao-time-to-epoch (&optional s) + "Transform a time string to an epoch integer in milliseconds." + (interactive) + (let ((s (or s (read-string "Time string: " (thing-at-point 'string))))) + (message "%s = %s" + s + (round (* 1000 (time-to-seconds (parse-time-string s))))))) + +(defun jao-epoch-to-time (&optional v) + "Transform an epoch, given in milliseconds, to a time string." + (interactive) + (let ((v (or v (read-number "Milliseconds: " (thing-at-point 'number))))) + (message "%s = %s" v + (format-time-string "%Y-%m-%d %H:%M:%S" + (seconds-to-time (/ v 1000.0)))))) +;;; mu4e +(jao-load-path "mu4e") +(use-package mu4e + :init + (setq mu4e-attachment-dir (expand-file-name "~/var/download/attachments") + mu4e-change-filenames-when-moving nil + mu4e-completing-read-function 'completing-read + mu4e-display-update-status-in-modeline nil + mu4e-get-mail-command "true" ;; "run-mb.sh || [ $? -eq 1 ]" + mu4e-headers-show-threads t + mu4e-headers-sort-direction 'ascending + mu4e-headers-visible-columns 100 + mu4e-headers-visible-lines 12 + mu4e-hide-index-messages t + mu4e-index-cleanup t ;; don't do a full cleanup check + mu4e-index-lazy-check t ;; don't consider up-to-date dirs + mu4e-maildir "~/var/mail" + mu4e-split-view 'horizontal ;; 'vertical + mu4e-update-interval 300 + mu4e-use-fancy-chars nil + mu4e-user-mail-address-list jao-mails + mu4e-view-show-addresses t + mu4e-view-show-images t + mu4e-maildir-shortcuts '((:maildir "/jao/inbox" :key ?j) + (:maildir "/bigml/inbox" :key ?b)) + jao-mu4e-uninteresting-mail-query + (concat + "flag:unread AND NOT flag:trashed" + " AND NOT (maildir:/bigml/inbox OR maildir:/bigml/bugs OR" + " maildir:/bigml/support OR maildir:/jao/inbox)") + jao-mu4e-interesting-mail-query + (concat + "flag:unread AND NOT flag:trashed" + " AND (maildir:/bigml/inbox OR maildir:/bigml/bugs OR" + " maildir:/bigml/support OR maildir:/jao/inbox)") + mu4e-bookmarks + `((:name "Inbox" :query ,jao-mu4e-interesting-mail-query :key ?i) + (:name "Other messages" + :query ,jao-mu4e-uninteresting-mail-query + :key 117) + (:name "Today's messages" :query "date:today..now" + :key 116) + (:name "Last 7 days" :query "date:7d..now" :hide-unread t + :key 119) + (:name "Messages with PDFs" + :query "mime:application/pdf OR mime:x-application/pdf" + :key 112))) + + :config + (defun jao-mu4e--maildir (msg) + (when msg + (let ((md (mu4e-message-field msg :maildir))) + (when (string-match "/\\([^/]+\\)/.*" md) + (match-string 1 md))))) + + (defun jao-mu4e--refile-folder (name) + (lambda (msg) + (let ((md (jao-mu4e--maildir msg))) + (if (string= md name) + (concat "/jao/" name) + (format "/%s/%s" md name))))) + + (setq mu4e-sent-folder (jao-mu4e--refile-folder "sent")) + (setq mu4e-drafts-folder (jao-mu4e--refile-folder "drafts")) + (setq mu4e-trash-folder (jao-mu4e--refile-folder "trash")) + (setq mu4e-refile-folder (jao-mu4e--refile-folder "trove")) + + (setq mu4e-contexts nil) + + (setq mu4e-view-show-images t) + (when (fboundp 'imagemagick-register-types) + (imagemagick-register-types)) + + (define-key mu4e-view-mode-map [remap mu4e-view-verify-msg-popup] + 'epa-mail-verify) + + ;; View html message in browser (type aV) + (add-to-list 'mu4e-view-actions + '("ViewInBrowser" . mu4e-action-view-in-browser) t)) + +;;; twtxt +(use-package twtxt + :ensure t + :init (setq twtxt-file (expand-file-name "~/doc/jao.io/twtxt") + twtxt-following + '(("yarn" "https://twtxt.net/user/news/twtxt.txt")))) +;;; corfu bits +(defun jao-corfu-enable-no-auto () + (setq-local corfu-auto nil) + (corfu-mode 1)) + +(defmacro jao-corfu-no-auto (mode) + (let ((mode-name (intern (format "%s-mode" mode))) + (hook-name (intern (format "%s-mode-hook" mode)))) + `(with-eval-after-load ',mode + (add-to-list 'corfu-excluded-modes ',mode-name) + (add-hook ',hook-name #'jao-corfu-enable-no-auto)))) + +(jao-corfu-no-auto eshell) + +;;; gnus bits + +(jao-transient-major-mode gnus-group + ["Search" + ("zc" "consult search" consult-notmuch) + ("zf" "consult folder search" jao-consult-notmuch-folder) + ("g" "gnus search" gnus-group-read-ephemeral-search-group)]) + +(defun jao-gnus-restart-servers () + (interactive) + (message "Restarting all servers...") + (gnus-group-enter-server-mode) + (gnus-server-close-all-servers) + (gnus-server-open-all-servers) + (gnus-server-exit) + (message "Restarting all servers... done")) + +;;;; delayed expiry +(defvar jao-gnus--expire-every 50) +(defvar jao-gnus--get-count (1+ jao-gnus--expire-every)) + +(defun jao-gnus-get-new-news (&optional arg) + (interactive "p") + (when (and jao-gnus--expire-every + (> jao-gnus--get-count jao-gnus--expire-every)) + (when jao-gnus-use-pm-imap (gnus-group-catchup "nnimap:pm/spam" t)) + (gnus-group-expire-all-groups) + (setq jao-gnus--get-count 0)) + (setq jao-gnus--get-count (1+ jao-gnus--get-count)) + (gnus-group-get-new-news (max (if (= 1 jao-gnus--get-count) 4 3) + (or arg 0)))) + +(define-key gnus-group-mode-map "g" 'jao-gnus-get-new-news) +(define-key gnus-group-mode-map "\C-x\C-s" #'gnus-group-save-newsrc) + +(defun jao-gnus--first-group () + (when (derived-mode-p 'gnus-group-mode) + (gnus-group-first-unread-group))) + +(with-eval-after-load "jao-afio" + (add-hook 'jao-afio-switch-hook #'jao-gnus--first-group)) + +;;;; remove HTML from From contents (arxiv with r2e) +(require 'shr) +(defvar jao-gnus--from-rx + (concat "From: \\\"?\\( " jao-gnus--news-rx "\\)")) + +(defun jao-gnus-remove-anchors () + (save-excursion + (goto-char (point-min)) + (cond ((re-search-forward jao-gnus--from-rx nil t) + (replace-match "" nil nil nil 1)) + ((re-search-forward "[gq].+ updates on arXiv.org: " nil t) + (replace-match "") + (let ((begin (point))) + (when (re-search-forward "^\\(To\\|Subject\\):" nil t) + (beginning-of-line) + (let ((shr-width 10000)) + (shr-render-region begin (1- (point)))))))))) + +(add-hook 'gnus-part-display-hook 'jao-gnus-remove-anchors) + +;;;; find message id +(defun jao-gnus-file-message-id (filename) + (with-temp-buffer + (insert-file filename) + (goto-char (point-min)) + (when (re-search-forward "^[Mm]essage-[Ii][Dd]: <?\\([^><]+\\)>?" nil t) + (match-string 1)))) +;;; old volume controls +(defun jao-player-volume-delta (raise) + (jao-player-vol-delta (if raise 5 -5)) + (sit-for 0.05) + (jao-player-show-volume)) + +(defun jao-player-volume-raise () + (interactive) + (jao-player-volume-delta t)) + +(defun jao-player-volume-lower () + (interactive) + (jao-player-volume-delta nil)) + +(defun jao-player-show-volume () + (interactive) + (jao-notify "Volume" (format "%s%%" (jao-player-volume)))) + +;;; snippets +(defun jao-sway-run-or-focus-tidal () + (interactive) + (if (jao-shell-running-p "tidal-hifi") + (jao-swaymsg "[app_id=tidal-hifi] scratchpad show") + (let ((c + "tidal-hifi --enable-features=UseOzonePlatform --ozone-platform=wayland &")) + (start-process-shell-command "tidal-hifi" nil c)) + (jao-sway-run-or-focus-tidal))) + +;; + +(defun jao-afio--set-mode-line () + (when (and window-system (fboundp 'jao-mode-line-hide-inactive)) + (if (string= "docs" (jao-afio-frame-name)) + (jao-mode-line-show-inactive nil) + (jao-mode-line-hide-inactive nil)))) + +(unless jao-modeline-in-minibuffer + (add-hook 'jao-afio-switch-hook #'jao-afio--set-mode-line)) diff --git a/attic/elisp/nnnm.el b/attic/elisp/nnnm.el new file mode 100644 index 0000000..552e95c --- /dev/null +++ b/attic/elisp/nnnm.el @@ -0,0 +1,265 @@ +;;; nnnm.el --- Gnus backend for notmuch -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 jao + +;; Author: jao <mail@jao.io> +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; 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 |