summaryrefslogtreecommitdiffhomepage
path: root/lib/eos
diff options
context:
space:
mode:
Diffstat (limited to 'lib/eos')
-rw-r--r--lib/eos/jao-afio.el80
-rw-r--r--lib/eos/jao-dirmon.el18
-rw-r--r--lib/eos/jao-minibuffer.el65
-rw-r--r--lib/eos/jao-mode-line.el23
-rw-r--r--lib/eos/jao-multisession.el341
-rw-r--r--lib/eos/jao-notify.el31
-rw-r--r--lib/eos/jao-r2e.el228
7 files changed, 712 insertions, 74 deletions
diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el
index b588989..c4445bd 100644
--- a/lib/eos/jao-afio.el
+++ b/lib/eos/jao-afio.el
@@ -1,6 +1,6 @@
;;; jao-afio.el --- workspaces in just one frame -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022, 2024 jao
+;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: frames
@@ -23,6 +23,8 @@
(require 'jao-doc-session)
(defvar jao-afio-use-frames (not window-system))
+(defvar jao-afio-frame-parameters nil)
+(defvar jao-afio-persist-configurations nil)
(defvar jao-open-doc-fun 'find-file)
(defvar jao-afio-mail-function 'gnus)
@@ -33,15 +35,40 @@
(defvar jao-afio--configs '(?c ?w ?g ?p ?s ?t))
(defvar jao-afio--previous-config (car jao-afio--configs))
+(define-multisession-variable jao-afio-configurations nil)
+
+(defun jao-afio--current-wc ()
+ (window-state-get (frame-root-window) t))
+
+(defun jao-afio-save-configuration ()
+ (interactive)
+ (when-let* ((c (jao-afio--current-config)))
+ (setf (alist-get c (multisession-value jao-afio-configurations))
+ (jao-afio--current-wc))
+ (message "Configuration of %s saved" (jao-afio-frame-name c))))
+
+(defun jao-afio-restore-configuration (c)
+ (when-let* ((_ jao-afio-persist-configurations)
+ (c (alist-get c (multisession-value jao-afio-configurations))))
+ (window-state-put c)
+ t))
+
(defun jao-afio--current-config (&optional c f)
(when c (modify-frame-parameters f `((afio . ,c))))
(frame-parameter f 'afio))
+(defun jao-afio--set-up-frame (cfg)
+ (when jao-afio-use-frames
+ (let ((fn (jao-afio-frame-name cfg)))
+ (set-frame-name fn)
+ (when-let* ((params (cadr (assoc fn jao-afio-frame-parameters))))
+ (modify-frame-parameters nil params)))))
+
(defun jao-afio--init (&optional f)
(interactive)
(jao-afio--current-config ?c)
(if jao-afio-use-frames
- (set-frame-name "W1")
+ (jao-afio--set-up-frame ?c)
(window-configuration-to-register ?c)))
(defun jao-afio--check-frame ()
@@ -71,17 +98,16 @@
;;;###autoload
(defun jao-afio-open-pdf-session (&optional docs)
(interactive)
- (let ((jao-doc-session-inhibit-save t))
- (dolist (doc (or docs (jao-doc-session)))
- (when (and doc (file-exists-p doc))
- (if (jao-pdf-is-pdf-file doc) (jao-open-doc doc) (find-file doc))
- (other-window 1)))
- (other-window 1)))
+ (dolist (doc (or docs (jao-doc-session)))
+ (when (and (stringp doc) (file-exists-p doc))
+ (if (jao-pdf-is-pdf-file doc) (jao-open-doc doc) (find-file doc))
+ (other-window 1)))
+ (other-window 1))
(defun jao-afio-open-doc ()
(interactive)
(delete-other-windows)
- (split-window-right)
+ (split-window-right 80)
(let ((docs (cl-remove-if-not 'jao-doc-session-is-doc (buffer-list))))
(if (car docs)
(progn (switch-to-buffer (car docs))
@@ -122,10 +148,10 @@
;;;###autoload
(defun jao-afio-open-gnus ()
(interactive)
- (delete-other-windows)
(jao-org-agenda)
(calendar)
(find-file (expand-file-name "inbox.org" org-directory))
+ (delete-other-windows)
(gnus)
(jao-gnus--set-summary-line))
@@ -147,10 +173,12 @@
(defun jao-afio--open-mail (fun)
(unless (get-buffer "*Calendar*") (calendar))
(delete-other-windows)
- (split-window-horizontally -80)
- (funcall fun)
- ;; (set-window-dedicated-p nil t)
- (jao-afio--mail-sidebar))
+ (if (< (frame-width) 160)
+ (funcall fun)
+ (split-window-horizontally -80)
+ (funcall fun)
+ ;; (set-window-dedicated-p nil t)
+ (jao-afio--mail-sidebar)))
;;;###autoload
(defun jao-afio-open-mail ()
@@ -162,12 +190,15 @@
;;;###autoload
(defun jao-afio-reset ()
(interactive)
- (delete-other-windows)
- (cl-case (jao-afio--current-config)
- (?w (jao-afio-open-www))
- (?g (jao-afio-open-mail))
- (?p (jao-afio-open-doc))
- (t (jao-afio-trisect))))
+ (let ((c (jao-afio--current-config)))
+ (unless (jao-afio-restore-configuration c)
+ (delete-other-windows)
+ (cl-case c
+ (?w (jao-afio-open-www))
+ (?g (jao-afio-open-mail))
+ (?p (jao-afio-open-doc))
+ (t (jao-afio-trisect)))
+ (when jao-afio-persist-configurations (jao-afio-save-configuration)))))
;;; go to frame
(defsubst jao-afio--find-frame (c)
@@ -195,16 +226,15 @@
(let ((f (jao-afio--find-frame next)))
(select-frame-set-input-focus (or f (make-frame)))
(when (setq reset (or reset (not f)))
- (set-frame-name
- (format "W%s" (or (jao-afio-frame-no next) next)))))
+ (jao-afio--set-up-frame next)))
(window-configuration-to-register (jao-afio--current-config))
(when (and (not reset) (get-register next))
(ignore-errors (jump-to-register next)))
(setq reset (or reset (not (get-register next)))))
(jao-afio--current-config next)
(unless (eq current next) (setq jao-afio--previous-config current))
- (when reset (jao-afio-reset))
- (run-hooks 'jao-afio-switch-hook)))))
+ (when reset (jao-afio-reset)))
+ (run-hooks 'jao-afio-switch-hook))))
(defun jao-afio-goto-main (&optional reset)
(interactive "P")
@@ -228,7 +258,7 @@
(defun jao-afio-goto-scratch (&optional one-win)
(interactive "P")
- (jao-afio--goto-frame ?s nil)
+ (jao-afio--goto-frame ?s one-win)
(when one-win (delete-other-windows)))
(defun jao-afio-goto-chats (&optional reset)
diff --git a/lib/eos/jao-dirmon.el b/lib/eos/jao-dirmon.el
index 9d748d1..6a897d3 100644
--- a/lib/eos/jao-dirmon.el
+++ b/lib/eos/jao-dirmon.el
@@ -1,6 +1,6 @@
;;; jao-dirmon.el --- little utility to monitor disk usage -*- lexical-binding: t; -*-
-;; Copyright (C) 2022 jao
+;; Copyright (C) 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: tools
@@ -25,12 +25,18 @@
;;; Code:
(require 'multisession)
+(require 'view)
(require 'jao-shell)
(define-multisession-variable jao-dirmon-last '())
+(defvar jao-dirmon-roots '("/var/local" "~"))
+
(defun jao-dirmon-dirs ()
- (jao-shell-cmd-lines "find ~ -mindepth 2 -maxdepth 3 -type d"))
+ (mapcan (lambda (d)
+ (jao-shell-cmd-lines
+ (format "find %s -mindepth 2 -maxdepth 3 -type d" d)))
+ jao-dirmon-roots))
(defun jao-dirmon-sizes ()
(mapcar (lambda (f)
@@ -40,9 +46,12 @@
(defvar jao-dirmon-threshold 100)
(defvar jao-dirmon-last-delta nil)
+(defvar jao-dirmon-buffer "*jao-dirmon")
(defun jao-dirmon--show-deltas (old current deltas)
- (with-temp-buffer
+ (with-current-buffer (get-buffer-create jao-dirmon-buffer)
+ (view-mode-disable)
+ (delete-region (point-min) (point-max))
(insert "High deltas since " (car old) "\n\n")
(dolist (d (seq-sort-by #'cdr #'> deltas))
(insert (format "- %s: %s Mb\n" (car d) (cdr d))))
@@ -52,6 +61,7 @@
(seq-sort-by #'cdr #'> current)))
(insert (format "- %s: %s Mb\n" (car c) (cdr c)))))
(beginning-of-buffer)
+ (view-mode-enable)
(pop-to-buffer (current-buffer) nil t)
(when (y-or-n-p "Save current state?")
(setf (multisession-value jao-dirmon-last)
@@ -66,7 +76,7 @@
(dolist (c current)
(let ((d (- (cdr c) (alist-get (car c) old 0 nil #'string=))))
(when (> (abs d) jao-dirmon-threshold)
- (push c high))))
+ (push (cons (car c) d) high))))
(setq jao-dirmon-last-delta high)
(jao-dirmon--show-deltas old current jao-dirmon-last-delta)
jao-dirmon-last-delta))
diff --git a/lib/eos/jao-minibuffer.el b/lib/eos/jao-minibuffer.el
index 77bd49a..552e183 100644
--- a/lib/eos/jao-minibuffer.el
+++ b/lib/eos/jao-minibuffer.el
@@ -1,6 +1,6 @@
;;; jao-minibuffer.el --- using the minibuffer to report status -*- lexical-binding: t; -*-
-;; Copyright (C) 2020, 2021, 2022, 2024 jao
+;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: extensions
@@ -34,25 +34,27 @@
(defvar jao-minibuffer-active-buffer-line-color "azure4")
(defvar jao-minibuffer-inactive-buffer-line-color "grey25")
(defvar jao-minibuffer-inhibit nil)
+(defvar jao-minibuffer-info-face 'default)
+(defvar jao-minibuffer-info-face-alt 'default)
(defconst jao-minibuffer--name " *Minibuf-0*")
(defun jao-minibuffer--trim (s w)
(if (< (string-width (or s "")) w)
(format (format "%%%ds" (if jao-minibuffer-align-right w (- w))) s)
- (substring s 0 w)))
+ (substring s 0 (min w (string-width s)))))
(defun jao-minibuffer--width ()
(cond ((numberp jao-minibuffer-frame-width) jao-minibuffer-frame-width)
(jao-minibuffer-maximized-frames-p (frame-width))
(t (min (frame-width) (window-width (minibuffer-window))))))
-(defun jao-minibuffer--format-info (&optional info)
- (let* ((info (or info jao-minibuffer-info))
- (info (if jao-minibuffer-align-right info (reverse info))))
- (mapconcat #'string-trim
- (seq-remove #'string-blank-p (mapcar 'format-mode-line info))
- " ")))
+(defun jao-minibuffer--format-info (&optional info alt-p)
+ (let* ((face (if alt-p jao-minibuffer-info-face-alt jao-minibuffer-info-face))
+ (info (or info jao-minibuffer-info))
+ (info (if jao-minibuffer-align-right info (reverse info)))
+ (info (seq-remove #'string-blank-p (mapcar 'format-mode-line info))))
+ (propertize (mapconcat #'string-trim info " ") 'face face)))
(defun jao-minibuffer--aligned (w)
(let* ((msg (jao-minibuffer--format-info))
@@ -74,13 +76,14 @@
msg))
(defun jao-minibuffer--prefix (msgs)
- (when-let (p (string-join (butlast msgs) "\n"))
+ (when-let* ((p (string-join (butlast msgs) "\n")))
(unless (string-blank-p p) (concat p "\n"))))
(defun jao-minibuffer--format-msg (msg)
(let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n" t)))
- (msgs (cl-remove-if (lambda (s) (get-text-property 0 'invisible s)) msgs))
- (prefix (jao-minibuffer--prefix msgs))
+ (msgs
+ (seq-remove (lambda (s) (get-text-property 0 'invisible s)) msgs))
+ (prefix (if msgs (jao-minibuffer--prefix msgs) ""))
(msg (or (car (last msgs)) ""))
(w (string-width msg)))
(if jao-minibuffer-align-right
@@ -91,14 +94,11 @@
(when jao-minibuffer-mode
(or (and (string= jao-minibuffer--name (or (buffer-name) "")) msg)
jao-minibuffer-inhibit
- (let* ((info (and jao-minibuffer-msg-info
- (jao-minibuffer--format-info jao-minibuffer-msg-info)))
- (info (or (and info msg (propertize info 'face 'jao-themes-dimm))
- info))
- (sep (if msg " - " ""))
- (pref (when info
- (let ((len (+ (length info) (length sep))))
- (format (format "\n%%%ds" len) ""))))
+ (and (not jao-minibuffer-msg-info) msg)
+ (let* ((info (jao-minibuffer--format-info jao-minibuffer-msg-info t))
+ (sep (if (string-blank-p (or msg "")) "" " - "))
+ (pref (let ((len (+ (string-width info) (string-width sep))))
+ (format (format "\n%%%ds" len) "")))
(msg (if (and msg pref)
(replace-regexp-in-string "\n" pref msg)
msg))
@@ -141,10 +141,10 @@
:global t :lighter "" :group 'jao
(if jao-minibuffer-mode
(progn ;; (advice-add 'select-window :after #'jao-minibuffer-refresh)
- (advice-add 'select-window :after #'jao-minibuffer--adjust-alignment)
- (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh)
- (setq clear-message-function #'jao-minibuffer--clear-message)
- (jao-minibuffer-refresh))
+ (advice-add 'select-window :after #'jao-minibuffer--adjust-alignment)
+ (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh)
+ (setq clear-message-function #'jao-minibuffer--clear-message)
+ (jao-minibuffer-refresh))
(advice-remove 'select-window #'jao-minibuffer-refresh)
(advice-remove 'force-mode-line-update #'jao-minibuffer-refresh)
(setq clear-message-function nil)
@@ -164,5 +164,24 @@
(not jao-minibuffer-adaptive-alignment))
(jao-minibuffer-refresh))
+(define-minor-mode jao-minibuffer-mode-line-mode
+ "Show info in mode line instead of minibuffer"
+ :global t :lighter "" :group 'jao
+ (let ((e '(" " (:eval jao-minibuffer-info))))
+ (if jao-minibuffer-mode-line-mode
+ (add-to-list 'global-mode-string e)
+ (setq global-mode-string (delete e global-mode-string)))))
+
+(defvar jao-minibuffer--title-format nil)
+
+(define-minor-mode jao-minibuffer-frame-title-mode
+ "Show info in frame title instead of minibuffer"
+ :global t :lighter "" :group 'jao
+ (when (not jao-minibuffer--title-format)
+ (setq jao-minibuffer--title-format frame-title-format))
+ (if jao-minibuffer-frame-title-mode
+ (setq frame-title-format '("emacs - " (:eval jao-minibuffer-info)))
+ (setq frame-title-format jao-minibuffer--title-format)))
+
(provide 'jao-minibuffer)
;;; jao-minibuffer.el ends here
diff --git a/lib/eos/jao-mode-line.el b/lib/eos/jao-mode-line.el
index e4f64c0..d3388e4 100644
--- a/lib/eos/jao-mode-line.el
+++ b/lib/eos/jao-mode-line.el
@@ -1,6 +1,6 @@
;;; jao-mode-line.el --- mode-line info -*- lexical-binding: t; -*-
-;; Copyright (C) 2022 jao
+;; Copyright (C) 2022, 2025 jao
;; Author: jao <mail@jao.io>
;; Keywords: convenience
@@ -31,7 +31,7 @@
;;;; mode line toggle
(defun jao-mode-line--face-height (face &optional all)
(let* ((h (face-attribute face :height (window-frame)))
- (nh (if (eq 'unspecified h) 1 'unspecified)))
+ (nh (if (eq 'unspecified h) 10 'unspecified)))
(set-face-attribute face (when (not all) (window-frame)) :height nh)))
(defun jao-mode-line--set-inactive-face (x frame)
@@ -41,7 +41,7 @@
;;;###autoload
(defun jao-mode-line-toggle (&optional all)
(interactive "P")
- (jao-mode-line--face-height 'mode-line all))
+ (jao-mode-line--face-height 'mode-line-active all))
;;;###autoload
(defun jao-mode-line-toggle-inactive (&optional all)
@@ -62,7 +62,7 @@
;;;###autoload
(defun jao-mode-line-hide-inactive (frame)
- (jao-mode-line--set-inactive-face 1 frame))
+ (jao-mode-line--set-inactive-face 10 frame))
;;;###autoload
(defun jao-mode-line-show-inactive (frame)
@@ -85,8 +85,6 @@
'gnus-article-mode
'gnus-summary-mode)
mode-line-buffer-identification)
- ;; ((derived-mode-p 'circe-channel-mode)
- ;; (format "%s [%d]" (buffer-name) (length (circe-channel-nicks))))
((not (null eww-data))
(or (plist-get eww-data :title) "No title"))
(t "%b"))))
@@ -108,7 +106,7 @@
;;;; mode line in minibuffer
-(defvar jao-mode-line--old-format nil)
+(defvar jao-mode-line--old-format mode-line-format)
(defvar jao-mode-line--face nil)
(defvar jao-mode-line--inactive-face nil)
(defvar jao-mode-line--props
@@ -127,15 +125,18 @@
(if inactive jao-mode-line--inactive-face jao-mode-line--face)))
(defun jao-mode-line-adjust-faces ()
- (let ((bg (and (display-graphic-p) (frame-parameter nil 'background-color)))
+ (interactive)
+ (let ((bg (and (display-graphic-p)
+ (frame-parameter nil 'background-color)))
(ol (and (display-graphic-p) jao-minibuffer-active-buffer-line-color))
- (ul (and (display-graphic-p) jao-minibuffer-inactive-buffer-line-color)))
+ (ul (and (display-graphic-p)
+ jao-minibuffer-inactive-buffer-line-color)))
(jao-mode-line--extract-face nil)
(jao-mode-line--extract-face t)
- (set-face-attribute 'mode-line nil :box nil :height 1
+ (set-face-attribute 'mode-line-active nil :box nil :height 10
:background bg :foreground bg
:overline ol :underline ul :extend t)
- (set-face-attribute 'mode-line-inactive nil :box nil :height 1
+ (set-face-attribute 'mode-line-inactive nil :box nil :height 10
:background bg :foreground bg
;; :overline bg
:underline ul :extend t)))
diff --git a/lib/eos/jao-multisession.el b/lib/eos/jao-multisession.el
new file mode 100644
index 0000000..8660611
--- /dev/null
+++ b/lib/eos/jao-multisession.el
@@ -0,0 +1,341 @@
+;;; multisession.el --- Multisession storage for variables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides multisession variables for Emacs Lisp, to
+;; make them persist between sessions.
+;;
+;; Use `define-multisession-variable' to define a multisession
+;; variable, and `multisession-value' to read its value. Use
+;; `list-multisession-values' to list multisession variables.
+;;
+;; Users might want to customize `multisession-storage' and
+;; `multisession-directory'.
+;;
+;; See Info node `(elisp) Multisession Variables' for more
+;; information.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'tabulated-list)
+
+(defcustom multisession-storage 'files
+ "Storage method for multisession variables.
+Valid methods are `sqlite' and `files'."
+ :type '(choice (const :tag "SQLite" sqlite)
+ (const :tag "Files" files))
+ :version "29.1"
+ :group 'files)
+
+(defcustom multisession-directory (expand-file-name "multisession/"
+ user-emacs-directory)
+ "Directory to store multisession variables."
+ :type 'file
+ :version "29.1"
+ :group 'files)
+
+;;;###autoload
+(defmacro define-multisession-variable (name initial-value &optional doc
+ &rest args)
+ "Make NAME into a multisession variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-multisession'."
+ (declare (indent defun))
+ (unless (plist-get args :package)
+ (setq args (nconc (list :package
+ (replace-regexp-in-string "-.*" ""
+ (symbol-name name)))
+ args)))
+ `(defvar ,name
+ (make-multisession :key ,(symbol-name name)
+ :initial-value ,initial-value
+ ,@args)
+ ,@(list doc)))
+
+(defconst multisession--unbound (make-symbol "unbound"))
+
+(cl-defstruct (multisession
+ (:constructor nil)
+ (:constructor multisession--create)
+ (:conc-name multisession--))
+ "A persistent variable that will live across Emacs invocations."
+ key
+ (initial-value nil)
+ package
+ (storage multisession-storage)
+ (synchronized nil)
+ (cached-value multisession--unbound)
+ (cached-sequence 0))
+
+(cl-defun make-multisession (&key key initial-value package synchronized
+ storage)
+ "Create a multisession object."
+ (unless package
+ (error "No package for the multisession object"))
+ (unless key
+ (error "No key for the multisession object"))
+ (unless (stringp package)
+ (error "The package has to be a string"))
+ (unless (stringp key)
+ (error "The key has to be a string"))
+ (multisession--create
+ :key key
+ :synchronized synchronized
+ :initial-value initial-value
+ :package package
+ :storage (or storage multisession-storage)))
+
+(defun multisession-value (object)
+ "Return the value of the multisession OBJECT."
+ (if (null user-init-file)
+ ;; If we don't have storage, then just return the value from the
+ ;; object.
+ (if (eq (multisession--cached-value object) multisession--unbound)
+ (multisession--initial-value object)
+ (multisession--cached-value object))
+ ;; We have storage, so we update from storage.
+ (multisession-backend-value (multisession--storage object) object)))
+
+(defun multisession--set-value (object value)
+ "Set the stored value of OBJECT to VALUE."
+ (if (null user-init-file)
+ ;; We have no backend, so just store the value.
+ (setf (multisession--cached-value object) value)
+ ;; We have a backend.
+ (multisession--backend-set-value (multisession--storage object)
+ object value)))
+
+(defun multisession-delete (object)
+ "Delete OBJECT from the backend storage."
+ (multisession--backend-delete (multisession--storage object) object))
+
+(gv-define-simple-setter multisession-value multisession--set-value)
+
+;; Files Backend
+
+(defun multisession--encode-file-name (name)
+ (url-hexify-string name))
+
+(defun multisession--read-file-value (file object)
+ (catch 'done
+ (let ((i 0)
+ last-error)
+ (while (< i 10)
+ (condition-case err
+ (throw 'done
+ (with-temp-buffer
+ (let* ((time (file-attribute-modification-time
+ (file-attributes file)))
+ (coding-system-for-read 'utf-8-emacs-unix))
+ (insert-file-contents file)
+ (let ((stored (read (current-buffer))))
+ (setf (multisession--cached-value object) stored
+ (multisession--cached-sequence object) time)
+ stored))))
+ ;; Windows uses OS-level file locking that may preclude
+ ;; reading the file in some circumstances. In addition,
+ ;; rename-file is not an atomic operation on MS-Windows,
+ ;; when the target file already exists, so there could be a
+ ;; small race window when the file to read doesn't yet
+ ;; exist. So when these problems happen, wait a bit and retry.
+ ((permission-denied file-missing)
+ (setq i (1+ i)
+ last-error err)
+ (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+ (signal (car last-error) (cdr last-error)))))
+
+(defun multisession--object-file-name (object)
+ (expand-file-name
+ (concat "files/"
+ (multisession--encode-file-name (multisession--package object))
+ "/"
+ (multisession--encode-file-name (multisession--key object))
+ ".value")
+ multisession-directory))
+
+(cl-defmethod multisession-backend-value ((_type (eql 'files)) object)
+ (let ((file (multisession--object-file-name object)))
+ (cond
+ ;; We have no value yet; see whether it's stored.
+ ((eq (multisession--cached-value object) multisession--unbound)
+ (if (file-exists-p file)
+ (multisession--read-file-value file object)
+ ;; Nope; return the initial value.
+ (multisession--initial-value object)))
+ ;; We have a value, but we want to update in case some other
+ ;; Emacs instance has updated.
+ ((multisession--synchronized object)
+ (if (and (file-exists-p file)
+ (time-less-p (multisession--cached-sequence object)
+ (file-attribute-modification-time
+ (file-attributes file))))
+ (multisession--read-file-value file object)
+ ;; Nothing, return the cached value.
+ (multisession--cached-value object)))
+ ;; Just return the cached value.
+ (t
+ (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql 'files))
+ object value)
+ (let ((file (multisession--object-file-name object))
+ (time (current-time)))
+ ;; Ensure that the directory exists.
+ (let ((dir (file-name-directory file)))
+ (unless (file-exists-p dir)
+ (make-directory dir t)))
+ (with-temp-buffer
+ (let ((print-length nil)
+ (print-circle t)
+ (print-level nil))
+ (prin1 value (current-buffer)))
+ (goto-char (point-min))
+ (condition-case nil
+ (read (current-buffer))
+ (error (error "Unable to store unreadable value: %s" (buffer-string))))
+ ;; Write to a temp file in the same directory and rename to the
+ ;; file for somewhat better atomicity.
+ (let ((coding-system-for-write 'utf-8-emacs-unix)
+ (create-lockfiles nil)
+ (temp (make-temp-name file))
+ (write-region-inhibit-fsync nil))
+ (write-region (point-min) (point-max) temp nil 'silent)
+ (set-file-times temp time)
+ (rename-file temp file t)))
+ (setf (multisession--cached-sequence object) time
+ (multisession--cached-value object) value)))
+
+(cl-defmethod multisession--backend-values ((_type (eql 'files)))
+ (mapcar (lambda (file)
+ (let ((bits (file-name-split file)))
+ (list (url-unhex-string (car (last bits 2)))
+ (url-unhex-string
+ (file-name-sans-extension (car (last bits))))
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8-emacs-unix))
+ (insert-file-contents file)
+ (read (current-buffer)))))))
+ (directory-files-recursively
+ (expand-file-name "files" multisession-directory)
+ "\\.value\\'")))
+
+(cl-defmethod multisession--backend-delete ((_type (eql 'files)) object)
+ (let ((file (multisession--object-file-name object)))
+ (when (file-exists-p file)
+ (delete-file file))))
+
+;; Mode for editing.
+
+(defvar-keymap multisession-edit-mode-map
+ :parent tabulated-list-mode-map
+ "d" #'multisession-delete-value
+ "e" #'multisession-edit-value)
+
+(define-derived-mode multisession-edit-mode special-mode "Multisession"
+ "This mode lists all elements in the \"multisession\" database."
+ :interactive nil
+ (buffer-disable-undo)
+ (setq-local buffer-read-only t
+ truncate-lines t)
+ (setq tabulated-list-format
+ [("Package" 10)
+ ("Key" 30)
+ ("Value" 30)])
+ (setq-local revert-buffer-function #'multisession-edit-mode--revert))
+
+;;;###autoload
+(defun list-multisession-values (&optional choose-storage)
+ "List all values in the \"multisession\" database.
+If CHOOSE-STORAGE (interactively, the prefix), query for the
+storage method to list."
+ (interactive "P")
+ (let ((storage
+ (if choose-storage
+ (intern (completing-read "Storage method: " '(sqlite files) nil t))
+ multisession-storage)))
+ (pop-to-buffer (get-buffer-create (format "*Multisession %s*" storage)))
+ (multisession-edit-mode)
+ (setq-local multisession-storage storage)
+ (multisession-edit-mode--revert)
+ (goto-char (point-min))))
+
+(defun multisession-edit-mode--revert (&rest _)
+ (let ((inhibit-read-only t)
+ (id (get-text-property (point) 'tabulated-list-id)))
+ (erase-buffer)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar (lambda (elem)
+ (list
+ (cons (car elem) (cadr elem))
+ (vector (car elem) (cadr elem)
+ (string-replace "\n" "\\n"
+ (format "%s" (caddr elem))))))
+ (multisession--backend-values multisession-storage)))
+ (tabulated-list-print t)
+ (goto-char (point-min))
+ (when id
+ (when-let ((match
+ (text-property-search-forward 'tabulated-list-id id t)))
+ (goto-char (prop-match-beginning match))))))
+
+(defun multisession-delete-value (id)
+ "Delete the value at point."
+ (interactive (list (get-text-property (point) 'tabulated-list-id))
+ multisession-edit-mode)
+ (unless id
+ (error "No value on the current line"))
+ (unless (yes-or-no-p "Really delete this item? ")
+ (user-error "Not deleting"))
+ (multisession--backend-delete multisession-storage
+ (make-multisession :package (car id)
+ :key (cdr id)))
+ (let ((inhibit-read-only t))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+
+(defun multisession-edit-value (id)
+ "Edit the value at point."
+ (interactive (list (get-text-property (point) 'tabulated-list-id))
+ multisession-edit-mode)
+ (unless id
+ (error "No value on the current line"))
+ (let* ((object (or
+ ;; If the multisession variable already exists, use
+ ;; it (so that we update it).
+ (if-let (sym (intern-soft (cdr id)))
+ (and (boundp sym) (symbol-value sym))
+ nil)
+ ;; Create a new object.
+ (make-multisession
+ :package (car id)
+ :key (cdr id)
+ :storage multisession-storage)))
+ (value (multisession-value object)))
+ (setf (multisession-value object)
+ (car (read-from-string
+ (read-string "New value: " (prin1-to-string value))))))
+ (multisession-edit-mode--revert))
+
+(provide 'jao-multisession)
+
+;;; multisession.el ends here
diff --git a/lib/eos/jao-notify.el b/lib/eos/jao-notify.el
index 623b8cc..8389b3a 100644
--- a/lib/eos/jao-notify.el
+++ b/lib/eos/jao-notify.el
@@ -1,6 +1,6 @@
;; jao-notify.el -- Interacting with notification daemon
-;; Copyright (c) 2017, 2019, 2020, 2021, 2024 Jose Antonio Ortega Ruiz
+;; Copyright (c) 2017, 2019, 2020, 2021, 2024, 2025 Jose Antonio Ortega Ruiz
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Start date: Sun Jan 08, 2017 20:24
@@ -17,21 +17,30 @@
(defvar jao-notify-audio-icon (jao-data-file "music-player-icon.png"))
(declare-function notifications-notify "notifications")
+(declare-function alert "alert")
+(declare-function jao-mac-notify "jao-mac")
;; "/usr/share/icons/Papirus/64x64/mimetypes/audio-x-generic.svg"
;; "/usr/share/icons/Tango/scalable/mimetypes/audio-x-generic.svg"
-(defun jao-notify (msg &optional title icon)
+(defun jao-notify (msg &optional title icon subtitle)
(let ((title (when (and title (not (string-blank-p title))) title)))
- (if jao-notify-use-messages
- (message "%s%s%s" (or title "") (if title ": " "") (or msg ""))
- (let* ((args `(:timeout ,jao-notify-timeout))
- (args (append args
- (if title `(:title ,title :body ,msg) `(:title ,msg))))
- (args (if (and (stringp icon) (file-exists-p icon))
- (append args `(:app-icon ,(format "%s" icon)))
- args)))
- (apply 'notifications-notify args)))))
+ (cond ((eq jao-notify-use-messages t)
+ (message "%s%s%s" (or title "") (if title ": " "") (or msg "")))
+ ((eq jao-notify-use-messages 'notification)
+ (let* ((args `(:timeout ,jao-notify-timeout))
+ (args (append args
+ (if title
+ `(:title ,title :body ,msg)
+ `(:title ,msg))))
+ (args (if (and (stringp icon) (file-exists-p icon))
+ (append args `(:app-icon ,(format "%s" icon)))
+ args)))
+ (apply 'notifications-notify args)))
+ ((eq jao-notify-use-messages 'alert)
+ (alert msg :title title :icon icon :never-persist t))
+ ((eq jao-notify-use-messages 'mac)
+ (jao-mac-notify title subtitle msg)))))
(provide 'jao-notify)
diff --git a/lib/eos/jao-r2e.el b/lib/eos/jao-r2e.el
new file mode 100644
index 0000000..09b4504
--- /dev/null
+++ b/lib/eos/jao-r2e.el
@@ -0,0 +1,228 @@
+;;; jao-r2e.el --- List of rss2email subscriptions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
+;; Keywords: news
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'jao-url)
+
+(autoload 'View-quit "view")
+(autoload 'eww-view-source "eww")
+(autoload 'jao-notmuch-subtags "jao-notmuch")
+
+(defvar jao-r2e-confirm-toggle nil)
+
+(defconst jao-r2e--buffer "*r2e*")
+(defun jao-r2e--buffer ()
+ (with-current-buffer (get-buffer-create jao-r2e--buffer)
+ (unless (derived-mode-p 'jao-r2e-mode)
+ (jao-r2e-mode))
+ (current-buffer)))
+
+(defvar jao-r2e-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map [?q] 'bury-buffer)
+ (define-key map [?n] 'next-line)
+ (define-key map [?p] 'previous-line)
+ (define-key map [?N] 'jao-r2e-next)
+ (define-key map [?P] 'jao-r2e-prev)
+ (define-key map [?g] 'jao-r2e-list)
+ (define-key map [?s] 'jao-r2e-subscribe)
+ (define-key map [?t] 'jao-r2e-toggle)
+ (define-key map [?D] 'jao-r2e-delete)
+ (define-key map [?u] 'jao-r2e-recover)
+ (define-key map [?y] 'jao-r2e-kill-url)
+ (define-key map [?x] 'jao-r2e-list-subscribed)
+ map))
+
+;;;###autoload
+(defun jao-r2e-mode ()
+ "A very simple mode to show the output of r2e commands."
+ (interactive)
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map jao-r2e-mode-map)
+ ;; (setq-local font-lock-defaults '(jao-r2e-font-lock-keywords))
+ (setq-local truncate-lines t)
+ (setq-local next-line-add-newlines nil)
+ (setq major-mode 'jao-r2e-mode)
+ (setq mode-name "r2e")
+ (read-only-mode 1))
+
+(defun jao-r2e--do (things &optional buffer)
+ "Execute a r2e command THINGS in the given BUFFER."
+ (let ((b (or buffer (pop-to-buffer (jao-r2e--buffer)))))
+ (let ((inhibit-read-only t)
+ (cmd (format "r2e %s" things)))
+ (unless buffer
+ (with-current-buffer b (delete-region (point-min) (point-max))))
+ (with-temp-message (format "Running: %s ...." cmd)
+ (shell-command cmd b))
+ (unless buffer (read-only-mode 1)))))
+
+(defconst jao-r2e--feed-rx
+ "^\\([0-9]+\\): \\[\\( \\|\\*\\)\\] \\([^ ]+\\) (\\(.+\\) -> \\(.+\\))")
+
+(defun jao-r2e--feed-at-point ()
+ (beginning-of-line)
+ (when-let* ((m (looking-at jao-r2e--feed-rx)))
+ (list (match-string 1)
+ (match-string 3)
+ (string= "*" (match-string 2))
+ (match-string 4)
+ (match-string 5))))
+
+(defun jao-r2e ()
+ (interactive)
+ (pop-to-buffer (jao-r2e--buffer))
+ (when (looking-at-p "^$")
+ (jao-r2e-list)))
+
+(defun jao-r2e-list ()
+ (interactive)
+ (jao-r2e--do "list"))
+
+(defun jao-r2e-list-subscribed (arg)
+ "Show only subscribed (unsubscribed with arg) feeds."
+ (interactive "P")
+ (jao-r2e-list)
+ (let ((inhibit-read-only t))
+ (flush-lines (if arg ".*\\[\\*\\].*" ".*\\[ \\].*"))))
+
+(defun jao-r2e--srx (opp)
+ (when-let* ((f (jao-r2e--feed-at-point)))
+ (let ((a (if opp (not (caddr f)) (caddr f))))
+ (format "^[0-9]+: \\[%s\\] " (if a "\\*" " ")))))
+
+(defun jao-r2e-next (opp)
+ "Next feed with the same (or opposite) status."
+ (interactive "P")
+ (when-let* ((rx (jao-r2e--srx opp)))
+ (next-line)
+ (when (re-search-forward rx nil t)
+ (beginning-of-line))))
+
+(defun jao-r2e-prev (opp)
+ "Previous feed with the same (or opposite) status."
+ (interactive "P")
+ (when-let* ((rx (jao-r2e--srx opp)))
+ (when (re-search-backward rx nil t)
+ (beginning-of-line))))
+
+(defun jao-r2e-kill-url ()
+ "Copy as kill the URL of the feed at point."
+ (interactive)
+ (let ((url (cadddr (jao-r2e--feed-at-point))))
+ (if (not url)
+ (error "No feed at point")
+ (kill-new url)
+ (message "%s" url))))
+
+(defun jao-r2e-toggle ()
+ (interactive)
+ (let ((f (jao-r2e--feed-at-point)))
+ (unless f (error "No feed at point"))
+ (let ((p (point))
+ (no (car f))
+ (name (cadr f))
+ (act (if (caddr f) "pause" "unpause")))
+ (when (or (not jao-r2e-confirm-toggle)
+ (yes-or-no-p (format "%s '%s'? " act name)))
+ (with-temp-buffer
+ (jao-r2e--do (format "%s %s" act no) (current-buffer)))
+ (jao-r2e-list)
+ (goto-char p)))))
+
+(define-multisession-variable jao-r2e-deleted-feeds '()
+ "List of rss2email feeds deleted at some point.")
+
+(defun jao-r2e--deleted () (multisession-value jao-r2e-deleted-feeds))
+
+(defun jao-r2e-delete ()
+ "Delete feed at point. Use `jao-r2e-recover' to undelete."
+ (interactive)
+ (let ((f (jao-r2e--feed-at-point)))
+ (unless f (error "No feed at point"))
+ (let ((p (point))
+ (no (car f))
+ (entry (cdr f)))
+ (when (yes-or-no-p (format "Delete feed '%s'" (car entry)))
+ (setf (multisession-value jao-r2e-deleted-feeds)
+ (cons entry (remove entry (jao-r2e--deleted))))
+ (with-temp-buffer
+ (jao-r2e--do (format "delete %s" no) (current-buffer)))
+ (jao-r2e-list)
+ (goto-char p)))))
+
+(defun jao-r2e-recover ()
+ (interactive)
+ (when (seq-empty-p (jao-r2e--deleted))
+ (error "No feeds recoverable at this point."))
+ (let* ((entries (jao-r2e--deleted))
+ (feed (completing-read "Recover feed: " entries)))
+ (when-let* ((ps (assoc feed entries))
+ (url (caddr ps))
+ (mail (car (last ps)))
+ (cat (when (string-match "feeds\\.\\(.+\\)@localhost" mail)
+ (match-string 1 mail))))
+ (jao-r2e-subscribe (list url feed) cat t)
+ (setf (multisession-value jao-r2e-deleted-feeds) (remove ps entries)))))
+
+(defun jao-r2e--find-url ()
+ (save-excursion
+ (when (derived-mode-p 'w3m-mode 'eww-mode)
+ (if (fboundp 'w3m-view-source) (w3m-view-source) (eww-view-source)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "type=\"application/\\(?:atom\\|rss\\)\\+xml\" +" nil t)
+ (let ((url (save-excursion
+ (when (re-search-forward
+ "href=\"\\([^\n\"]+\\)\"" nil t)
+ (match-string-no-properties 1))))
+ (title (when (re-search-forward
+ "\\(?:title=\"\\([^\n\"]+\\)\" +\\)" nil t)
+ (match-string-no-properties 1))))
+ (cond ((derived-mode-p 'w3m-view-mode) (w3m-view-source))
+ ((string-match-p ".*\\*eww-source\\b.*" (buffer-name))
+ (View-quit)))
+ (when url (cons url (or title "")))))))
+
+(defun jao-r2e-subscribe (url &optional cat relist)
+ "Subscribe to a given RSS URL. If URL not given, look for it."
+ (interactive (list (or (jao-url-around-point)
+ (jao-r2e--find-url)
+ (read-string "Feed URL: "))))
+ (let* ((url+title (ensure-list url))
+ (url (car url+title))
+ (title (cdr url+title)))
+ (unless url (error "No feeds found"))
+ (let ((url (if (string-match "^feed:" url) (substring url 5) url)))
+ (when (y-or-n-p (format "Subscribe to <%s>? " url))
+ (let* ((name (read-string "Feed name: " title))
+ (cats (cons "prog" (jao-notmuch-subtags "feeds")))
+ (cat (completing-read "Category: " cats nil t cat))
+ (subs (format "r2e add %s '%s' feeds.%s@localhost"
+ name url cat)))
+ (with-temp-message "Subscribing..."
+ (shell-command-to-string subs))
+ (with-temp-message "Retrieving feed..."
+ (shell-command (format "r2e run %s" name)))
+ (when relist (jao-r2e-list)))))))
+
+(provide 'jao-r2e)
+;;; jao-r2e.el ends here
generated by cgit v1.2.3 (git 2.46.0) at 2025-11-26 08:18:11 +0000