diff options
Diffstat (limited to 'lib')
47 files changed, 2730 insertions, 1318 deletions
diff --git a/lib/doc/jao-doc-session.el b/lib/doc/jao-doc-session.el index 928cf26..a846302 100644 --- a/lib/doc/jao-doc-session.el +++ b/lib/doc/jao-doc-session.el @@ -1,6 +1,6 @@ ;;; jao-doc-session.el --- persistent document sessions -*- lexical-binding: t; -*- -;; Copyright (C) 2022, 2024 jao +;; Copyright (C) 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: docs @@ -20,15 +20,20 @@ ;;; Code: -(persist-defvar jao-doc-session nil "Documents session") +(require 'multisession) -(defvar-local jao-doc-session--is-doc nil) +(define-multisession-variable jao-doc--session nil) + +(defun jao-doc-session () (multisession-value jao-doc--session)) + +(defvar-local jao-doc-session-is-doc nil + "Locally marks a buffer as belonging to a session. + +See also `jao-doc-session-mark'.") (defun jao-doc-session-is-doc (&optional buffer) "Check whether the given or current buffer belong to the doc session." - (buffer-local-value 'jao-doc-session--is-doc (or buffer (current-buffer)))) - -(defun jao-doc-session (&optional file) jao-doc-session) + (buffer-local-value 'jao-doc-session-is-doc (or buffer (current-buffer)))) (defun jao-doc-session-save (&optional skip-current force) "Traverse all current buffers and update the value of `jao-doc-session'." @@ -36,24 +41,24 @@ (let ((docs '()) (cb (and skip-current (current-buffer)))) (dolist (b (buffer-list)) - (when-let* ((fs (and (not (eq cb b)) (jao-doc-session-is-doc b)))) - (dolist (f fs) (add-to-list 'docs f)))) + (when-let* ((fs (and (not (eq cb b)) (jao-doc-session-is-doc b))) + (fs (if (listp fs) fs (list (buffer-file-name b))))) + (dolist (f fs) (push f docs)))) (when (or force (> (length docs) 0)) - (setq jao-doc-session docs)))) + (setf (multisession-value jao-doc--session) docs)))) (defun jao-doc-session-mark (&optional path) "Mark the current buffer's file, or PATH, as persistent across sessions." - (unless (listp jao-doc-session--is-doc) - (setq jao-doc-session--is-doc (ensure-list jao-doc-session--is-doc))) - (cl-pushnew (or path (buffer-file-name)) jao-doc-session--is-doc) + (unless (listp jao-doc-session-is-doc) + (setq jao-doc-session-is-doc (ensure-list jao-doc-session-is-doc))) + (cl-pushnew (or path (buffer-file-name)) jao-doc-session-is-doc) (jao-doc-session-save)) (defun jao-doc-session--maybe-save () (when (jao-doc-session-is-doc) (jao-doc-session-save t))) -(defvar jao-doc-session-inhibit-save nil) - (add-hook 'kill-buffer-hook #'jao-doc-session--maybe-save) +(add-hook 'kill-emacs-hook #'jao-doc-session-save) (provide 'jao-doc-session) ;;; jao-doc-session.el ends here diff --git a/lib/doc/jao-doc-view.el b/lib/doc/jao-doc-view.el index 75c2bae..74c4751 100644 --- a/lib/doc/jao-doc-view.el +++ b/lib/doc/jao-doc-view.el @@ -1,6 +1,6 @@ ;;; jao-doc-view.el -- extensions for doc-view -*- lexical-binding: t; -*- -;; Copyright (c) 2013, 2015, 2017, 2018, 2019, 2021, 2022, 2024 Jose Antonio Ortega Ruiz +;; Copyright (c) 2013, 2015, 2017, 2018, 2019, 2021, 2022, 2026 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 @@ -18,9 +18,15 @@ ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Fri Feb 15, 2013 01:21 +(require 'browse-url) +(require 'thingatpt) (require 'doc-view) (require 'jao-pdf) +(declare-function pdf-view-image-size "pdf-view") +(declare-function pdf-view-goto-page "pdf-view") +(declare-function pdf-view-current-page "pdf-view") + ;;; Utilities (defmacro jao-doc-view--funcall (a b &rest args) @@ -39,8 +45,7 @@ ;;; imenu (defun jao-doc-view-enable-imenu (file-name goto-page) - (let ((ifun (lambda () (doc-view-imenu-index file-name goto-page))) - (doc-view-imenu-enabled t)) + (let ((ifun (lambda () (doc-view-imenu-index file-name goto-page)))) (doc-view-imenu-setup) (setq-local imenu-create-index-function ifun))) @@ -48,15 +53,15 @@ (defvar-local jao-doc-view--trail-back ()) (defvar-local jao-doc-view--trail-fwd ()) -(defun jao-doc-view--trail-push (dest-page) +(defun jao-doc-view--trail-push (_dest-page) (when-let* ((page (jao-doc-view-current-page))) (unless (eq (car jao-doc-view--trail-back) page) - (push page jao-doc-view--trail-back)))) + (cl-pushnew page jao-doc-view--trail-back)))) (defun jao-doc-view-back () (interactive nil doc-view-mode) (if-let* ((p (pop jao-doc-view--trail-back))) - (progn (push (jao-doc-view-current-page) jao-doc-view--trail-fwd) + (progn (cl-pushnew (jao-doc-view-current-page) jao-doc-view--trail-fwd) (jao-doc-view-goto-page p)) (message "No more back marks."))) @@ -116,8 +121,7 @@ ((zerop (length urls)) (message "No URLs in this %s" (if all "document" "page"))) (t (when-let* ((url (completing-read "URL: " urls nil nil - (when (null (cdr urls)) - (car urls))))) + (when (null (cdr urls)) (car urls))))) (browse-url url)))))) ;;; . diff --git a/lib/doc/jao-org-focus.el b/lib/doc/jao-org-focus.el new file mode 100644 index 0000000..0d0b02b --- /dev/null +++ b/lib/doc/jao-org-focus.el @@ -0,0 +1,167 @@ +;;; jao-org-focus.el --- focusing on org subtrees -*- lexical-binding: t; -*- + +;; Copyright (C) 2025, 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: docs + +;; 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 'org) +(require 'cl-lib) + +(defvar-local jao-org-focus--parent nil) +(defvar-local jao-org-focus--section nil) + +(defvar jao-org-focus-siblings '("escaleta.org" . "novela.org")) + +(defun jao-org-focus--header-title () + (when-let* ((elem (org-element-at-point)) + (header (if (eq 'headline (org-element-type elem)) + elem + (org-previous-visible-heading 1) + (org-element-at-point)))) + (org-element-property :title header))) + +(defun jao-org-focus--is-outline () + (string= (car jao-org-focus-siblings) + (file-name-nondirectory (or (buffer-file-name) "")))) + +(defun jao-org-focus--jump-to-title (file title) + (let* ((file (if (bufferp file) (buffer-file-name file) file)) + (link (format "[[%s::*%s]]" file title))) + (org-link-open-from-string link))) + +;;;###autoload +(defun jao-org-focus-jump-to-sibling () + (interactive) + (when-let* ((title (save-excursion (jao-org-focus--header-title))) + (file (if (jao-org-focus--is-outline) + (cdr jao-org-focus-siblings) + (car jao-org-focus-siblings))) + (link (format "[[./%s::*%s]]" file title))) + (jao-org-focus--jump-to-title (format "./%s" file) title))) + +;;; focus on subtree +;;;###autoload +(defun jao-org-focus () + "Pop creatingly to an indirect buffer focused on the encloing subtree. + +When invoked on an indirect buffer, pops back to its base." + (interactive) + (when (jao-org-focus--is-outline) + (jao-org-focus-jump-to-sibling)) + (if-let* ((b (get-buffer (or jao-org-focus--parent "")))) + (let ((title (save-excursion + (goto-char (point-min)) + (jao-org-focus--header-title)))) + (jao-org-focus--jump-to-title b title)) + (when-let* ((title (jao-org-focus--header-title)) + (parent (buffer-name)) + (bname (format "%s [%s]" title parent))) + (if-let* ((b (get-buffer bname))) + (pop-to-buffer b) + (clone-indirect-buffer bname t) + (org-focus-mode -1) + (org-focus-child-mode) + (setq jao-org-focus--parent parent + jao-org-focus--section title) + (org-narrow-to-subtree) + (outline-show-subtree) + (count-words (point-min) (point-max)))))) + +(defun jao-org-focus-redisplay () + "Redisplay a focused buffer. + +Useful when its parent has been reorganised and the narrowing is out of +sync." + (interactive) + (when-let* ((title jao-org-focus--section)) + (widen) + (goto-char (point-min)) + (when (re-search-forward (format "\\*+ %s" title) nil t) + (org-narrow-to-subtree) + (goto-char (point-min))))) + +(defun jao-org-focus-redisplay-children () + "Find focused children and redisplay them." + (interactive) + (dolist (b (jao-org-focus-list)) + (with-current-buffer b + (save-excursion (jao-org-focus-redisplay))))) + +(defun jao-org-focus-list (&optional any-parent exclude) + "List of buffers that are focusing on a subtree of this one or its parent." + (let ((n (or jao-org-focus--parent (buffer-name)))) + (seq-filter (lambda (b) + (let ((p (buffer-local-value 'jao-org-focus--parent b))) + (and p + (or any-parent (string= n p)) + (or (not exclude) + (not (string= (buffer-name b) exclude)))))) + (buffer-list)))) + +(defvar jao-org-focus--focused-history nil) + +;;;###autoload +(defun jao-org-focus-switch (arg) + "Read with completion a focused child and pop to it. + +With arg, offer to switch to all children, regardless of their parent." + (interactive "P") + (let ((fl (mapcar 'buffer-name (jao-org-focus-list arg (buffer-name))))) + (unless fl (error "No focused children")) + (pop-to-buffer + (completing-read "Focused child: " fl + nil t nil 'jao-org-focus--focused-history)))) + +;;;###autoload +(defun jao-org-focus-goto-line (n) + (interactive "NGo to line: ") + (goto-char (point-min)) + (forward-visible-line n)) + +;;;###autoload +(define-minor-mode org-focus-mode + "A mode where keeping track of focused children is on by default." + :lighter " â—Ž" + :keymap '(("\C-ce" . jao-org-focus-jump-to-sibling) + ("\C-cl" . jao-org-focus-switch) + ("\C-cR" . jao-org-focus-redisplay) + ("\C-co" . jao-org-focus) + ("\C-cw" . count-words)) + (if org-focus-mode + (add-hook 'after-save-hook #'jao-org-focus-redisplay-children nil t) + (remove-hook 'after-save-hook #'jao-org-focus-redisplay-children t))) + +;;;###autoload +(define-minor-mode org-focus-child-mode + "A mode for the children of a focused org buffer." + :lighter " â—‰" + :keymap (let ((map (make-keymap))) + (suppress-keymap map) + (keymap-set map "<remap> <goto-line>" #'jao-org-focus-goto-line) + map) + (when (and org-focus-child-mode (require 'symbol-overlay nil t)) + (face-remap-reset-base 'symbol-overlay-default-face) + (face-remap-add-relative 'symbol-overlay-default-face 'warning 'underline) + (symbol-overlay-mode 1))) + +(with-eval-after-load 'symbol-overlay + (keymap-set org-focus-mode-map "M-n" 'symbol-overlay-jump-next) + (keymap-set org-focus-mode-map "M-p" 'symbol-overlay-jump-prev)) + + +(provide 'jao-org-focus) +;;; jao-org-focus.el ends here diff --git a/lib/doc/jao-org-links.el b/lib/doc/jao-org-links.el index 4fefedd..1bd8709 100644 --- a/lib/doc/jao-org-links.el +++ b/lib/doc/jao-org-links.el @@ -1,9 +1,14 @@ ;; -*- lexical-binding: t; -*- +(require 'org) +(require 'browse-url) (require 'jao-org-notes) (require 'jao-doc-view) (require 'jao-doc-session) (require 'jao-pdf) +(require 'jao-afio) + +(declare-function jao-pdf-skim-org "jao-mac") (defvar jao-org--sink-dir "./") (defvar jao-org-open-pdf-fun #'jao-org--default-open) @@ -17,8 +22,9 @@ (funcall (or jao-org-open-pdf-fun #'jao-org--default-open) path page height)) (defun jao-org-links--open-pdf (link) - "Open LINK in pdf-view-mode." - (cond ((string-match "\\(.*\\)::\\([0-9]*\\)\\+\\+\\([[0-9]\\.*[0-9]*\\)" link) + "Open LINK using `jaor-org-open-pdf-fn'." + (cond ((string-match "\\(.*\\)::\\([0-9]*\\)\\+\\+\\([[0-9]\\.*[0-9]*\\)" + link) (let* ((path (match-string 1 link)) (page (string-to-number (match-string 2 link))) (height (string-to-number (match-string 3 link)))) @@ -45,7 +51,7 @@ (defun jao-org-links--complete-doc (&optional arg) (let ((default-directory jao-org--sink-dir)) (let ((f (replace-regexp-in-string "^file:" "doc:" - (org-file-complete-link arg)))) + (org-link-complete-file arg)))) (if (jao-pdf-is-pdf-file f) (let ((page (read-from-minibuffer "Page: " ""))) (if (> (string-to-number page) 0) @@ -101,22 +107,30 @@ (insert "\n#+startup: latexpreview\n\n")) ;;;###autoload -(defun jao-org-pdf-goto-org (arg) +(defun jao-org-pdf-goto-org (arg &optional file-name) (interactive "P") - (when (jao-pdf-is-pdf-file buffer-file-name) - (let* ((file (jao-org-notes-find-for-pdf)) - (new (not (file-exists-p file))) - (title (jao-pdf-title))) - (when (or arg new) (org-store-link nil t)) + (when (jao-pdf-is-pdf-file (or file-name buffer-file-name)) + (let* ((file (jao-org-notes-find-for-pdf file-name)) + (new (not (file-exists-p file)))) + (if (and (not file-name) (or arg new)) + (org-store-link nil t) + (when (fboundp 'jao-pdf-skim-org-link) + (when-let* ((lnk (jao-pdf-skim-org-link nil))) + (kill-new lnk)))) (find-file-other-window file) (when new - (jao-org-insert-doc-skeleton title) + (jao-org-insert-doc-skeleton (jao-pdf-title file-name)) (org-insert-link))))) ;;;###autoload (defun jao-org-pdf-goto-org* () (interactive) (jao-org-pdf-goto-org t)) ;;;###autoload +(defun jao-org-org-to-pdf-file () + (expand-file-name (concat "doc/" (file-name-base buffer-file-name) ".pdf") + (file-name-directory jao-org-notes-dir))) + +;;;###autoload (defun jao-org-goto-pdf () (interactive) (if-let* ((f (jao-org-org-to-pdf-file))) diff --git a/lib/doc/jao-org-notes.el b/lib/doc/jao-org-notes.el index e47f845..929ab66 100644 --- a/lib/doc/jao-org-notes.el +++ b/lib/doc/jao-org-notes.el @@ -1,6 +1,6 @@ ;;; jao-org-notes.el --- A simple system for org note taking -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022, 2024 jao +;; Copyright (C) 2020, 2021, 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: tools @@ -35,7 +35,7 @@ (defun jao-org-notes--rg-cmd (rgx &rest args) `("rg" "--null" "--line-buffered" "--color=never" "--max-columns=250" - "--type=org" "--line-number" "--no-heading" "--smart-case" + "--type=org" "--line-number" "--no-heading" "--smart-case" "--follow" ,@args ,default-directory "-e" ,rgx)) (defun jao-org-notes--rg-title-or-tags (str) @@ -45,7 +45,8 @@ (default-directory (if (file-directory-p d) (expand-file-name d) default-directory)) (ts (mapconcat #'identity (split-string str "[:,]+" t) ":|")) - (rgx (format "^#.(title: .*%s|(tags:.*(%s:)))" str ts))) + (s (mapconcat #'identity (cons str (split-string str nil t)) "|")) + (rgx (format "^#.(title: .*(%s)|(tags:.*(%s:)))" s ts))) (jao-org-notes--rg-cmd rgx "-m" "2"))) (defun jao-org-notes--clean-match (m) @@ -57,7 +58,11 @@ (string-to-number (cadr m)))) (defun jao-org-notes--matches (lines) - (mapcar (lambda (l) (jao-org-notes--clean-match (split-string l "\0" t))) lines)) + (seq-keep (lambda (l) + (let ((m (split-string (or l "") "\0" t))) + (when (and (car m) (cadr m)) + (jao-org-notes--clean-match m)))) + lines)) (defun jao-org-notes--grep-rx (rx &rest rg-args) (let ((default-directory jao-org-notes-dir)) @@ -71,14 +76,15 @@ (and (string-match-p "^[^:]+ + :" m) "tags") "titles")) -(defun jao-org-notes--consult-rg (prompt &optional cat no-req cmd initial) +(defun jao-org-notes--consult-rg (prompt &optional cat no-req initial) (let ((default-directory (expand-file-name (or cat "") jao-org-notes-dir))) (consult--read - (consult--async-command #'jao-org-notes--rg-title-or-tags - (consult--async-transform jao-org-notes--matches)) + (consult--async-pipeline + (consult--process-collection #'jao-org-notes--rg-title-or-tags) + (consult--async-transform #'jao-org-notes--matches)) :prompt prompt - :initial (consult--async-split-initial (or initial "")) - :add-history (concat (consult--async-split-initial (thing-at-point 'symbol))) + :initial (or initial "") + :add-history (thing-at-point 'symbol) :require-match (not no-req) :category 'jao-org-notes-lookup :group 'jao-org-notes--consult-group @@ -87,7 +93,7 @@ :history '(:input jao-org-notes--grep-history)))) (defun jao-org-notes-cats () - (seq-difference (directory-files jao-org-notes-dir) '("." ".." "attic"))) + (directory-files jao-org-notes-dir nil "^[^.]")) (defun jao-org-notes--cat () (let* ((cat (completing-read "Top level category: " (jao-org-notes-cats)))) @@ -96,7 +102,7 @@ (defun jao-org-notes--insert-title (&optional title) (let* ((cat (jao-org-notes--cat)) - (note (jao-org-notes--consult-rg "Title: " cat t nil title)) + (note (jao-org-notes--consult-rg "Title: " cat t title)) (title (file-name-base note)) (title (replace-regexp-in-string "^#" "" title))) (when (not (string-empty-p title)) @@ -117,7 +123,8 @@ (defvar jao-org-notes--tag-history nil) (defun jao-org-notes--read-tags () - (let* ((tags (completing-read-multiple "Tags: " jao-org-notes--tags nil nil nil + (let* ((tags (completing-read-multiple "Tags: " + jao-org-notes--tags nil nil nil 'jao-org-notes--tag-history))) (setq jao-org-notes--tags (seq-union jao-org-notes--tags tags #'string=)) tags)) @@ -137,40 +144,61 @@ (let* ((file-name (or file-name buffer-file-name)) (bn (file-name-base file-name)) (rx (format "%s\\.org$" (regexp-quote bn))) - (pred (lambda () (string-prefix-p jao-org-notes-dir buffer-file-name)))) + (pred (lambda () + (string-prefix-p jao-org-notes-dir buffer-file-name)))) (save-some-buffers nil pred) (or (car (directory-files-recursively jao-org-notes-dir rx)) (let* ((d (completing-read "Notes subdir: " (jao-org-notes-cats) nil t)) (d (file-name-as-directory d))) (expand-file-name (concat d bn ".org") jao-org-notes-dir))))) +;;;###autoload (defun jao-org-notes-open () - "Search for a note file, matching tags and titles with completion." + "Search for a note file, matching tags and titles with completion. + +If the search string starts with a folder name followed by a +slash (e.g. `emacs/foo'), the search is performed only in the given +notes folder (when it exists). + +Search terms that start with a colon are interpreted as tags, and can +appear in any order in the tags list. +" (interactive) - (when-let* ((f (jao-org-notes--consult-rg "Search notes: "))) + (when-let* ((f (jao-org-notes--consult-rg "Search tags and titles: "))) (find-file f))) +(defvar jao-org-notes-consult-ripgrep-args + (format "%s -L" consult-ripgrep-args)) + +(defun jao-org-notes-consult-ripgrep (&optional ask initial) + "Search over notes in given notes categories (or all of them), using rg." + (interactive "P") + (let ((cat (when ask (completing-read "Category: " (jao-org-notes-cats)))) + (consult-ripgrep-args jao-org-notes-consult-ripgrep-args)) + (consult-ripgrep (expand-file-name (or cat "") jao-org-notes-dir) initial))) + +(defun jao-org-notes-consult-ripgrep-category (&optional initial) + "Search over notes in a given notes category." + (interactive "P") + (jao-org-notes-consult-ripgrep t initial)) + (defun jao-org-notes-consult-tags () "Search for a note file, matching all tags with completion." (interactive) (let* ((tags (jao-org-notes--read-tags)) (init (concat "^..tags: " (mapconcat #'identity tags " ")))) - (consult-ripgrep jao-org-notes-dir init))) - -(defun jao-org-notes-consult-ripgrep (&optional initial cat) - (interactive) - (consult-ripgrep (expand-file-name (or cat "") jao-org-notes-dir) initial)) + (jao-org-notes-consult-ripgrep init))) -(defun jao-org-notes-create (&optional title) +(defun jao-org-notes-create (&optional title ret-buffer) "Create a new note file, matching tags and titles with completion." (interactive) (when (jao-org-notes--insert-title title) - (org-insert-time-stamp (current-time) t t "#+date: " "\n") (insert "#+tags: :" (mapconcat #'identity (jao-org-notes--read-tags) ":") - ":\n")) + ":\n") + (org-insert-time-stamp (current-time) t t "#+date: " "\n")) (save-buffer) - (current-buffer)) + (if ret-buffer (current-buffer) (buffer-file-name))) (defun jao-org-notes-backlinks () "Show a list of note files linking to the current one." @@ -204,15 +232,15 @@ (interactive) (message "%d notes, %d tags in %s" (length (jao-org-notes-list)) - (length jao-org--notes-tags) + (length jao-org-notes--tags) jao-org-notes-dir)) ;;;###autoload (defun jao-org-notes-setup (mnemonic) - "Set up the notes system, providing a mnemonic character for its org template." - (setq org-capture-templates - (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic)) - jao-org-notes--tags (jao-org-notes-all-tags)) + "Set up the notes system, providing a mnemonic char for its org template." + (require 'org-capture) + (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic)) + (setq jao-org-notes--tags (jao-org-notes-all-tags)) (when (fboundp 'org-capture-upgrade-templates) (org-capture-upgrade-templates org-capture-templates))) diff --git a/lib/doc/jao-pdf.el b/lib/doc/jao-pdf.el index 1ee74bc..01334b1 100644 --- a/lib/doc/jao-pdf.el +++ b/lib/doc/jao-pdf.el @@ -1,6 +1,6 @@ ;;; jao-pdf.el --- utilities for pdf files -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: docs @@ -27,10 +27,14 @@ ;; - Interoperability with zathura. (require 'jao-doc-session) +(require 'browse-url) ;;; PDF info (declare-function 'pdf-info-outline "pdf-info") +(defvar jao-pdf-org-dir nil) + +(defun jao-pdf-org-dir () jao-pdf-org-dir) (defvar-local jao-pdf--outline nil) @@ -56,7 +60,7 @@ (setq-local jao-pdf--outline (doc-view--pdf-outline file-name))) (let ((page (or page (and (derived-mode-p 'doc-view-mode) (doc-view-current-page)) - (and (derived-mode-p 'pdf-view) (pdf-view-current-page)))) + (and (fboundp 'pdf-view-current-page) (pdf-view-current-page)))) (outline jao-pdf--outline) (cur-page 0) (cur-title (jao-pdf-title (or file-name buffer-file-name "title")))) @@ -91,10 +95,35 @@ (fn (file-name-nondirectory file)) (lnk (format "doc:%s::%s" fn page)) (desc (format "%s (p. %s)" (jao-pdf-section-title page file) no))) - (org-make-link-string lnk desc))) + (org-link-make-string lnk desc))) (defun jao-pdf-zathura-org-link (title) (jao-pdf--zathura-link (jao-pdf-zathura-file-info title))) +;;; Open doc functions +(defvar jao-pdf-open-in-emacs t) + +(defun jao-open-doc (&optional file page height) + (interactive) + (when-let* ((file (or file + (read-file-name "Document: " + (concat (jao-pdf-org-dir) "/doc/"))))) + (funcall jao-open-doc-fun file page height))) + +;;; doc:// links for browse-url + +(defun jao-open-doc-url (url &rest _) + (when (string-match "doc://\\([^?]+\\)\\(\\?.*\\)?" url) + (let ((file (match-string 1 url)) + (page (when-let* ((qs (match-string 2 url)) + (long (> (length qs) 1)) + (ps (url-parse-query-string (substring qs 1))) + (pn (cadr (assoc "page" ps)))) + (string-to-number pn)))) + (jao-open-doc (expand-file-name (concat "doc/" file) jao-org-dir) page)))) + +(add-to-list 'browse-url-handlers (cons "^doc://.+" 'jao-open-doc-url)) + + (provide 'jao-pdf) ;;; jao-pdf.el ends here diff --git a/lib/doc/jao-words.el b/lib/doc/jao-words.el new file mode 100644 index 0000000..5d5111d --- /dev/null +++ b/lib/doc/jao-words.el @@ -0,0 +1,80 @@ +;;; jao-words.el --- utilities for word stats -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: text + +;; 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: + +;; Simple word counting and classification + +;;; Code: + +(require 'org) +(require 'cl-lib) + +(defvar jao-words-min-length 3) +(defvar jao-words-max-lines 12) +(defvar jao-words-min-line-distance 10) + +(defun jao-words--word-lines (buffer word) + (let ((lines nil) + (last-line nil) + (case-fold-search nil) + (rx (format "\\b%s\\b" (regexp-quote word)))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (while (and (< (length lines) jao-words-max-lines) + (re-search-forward rx nil t)) + (let* ((line (line-number-at-pos)) + (d (- line (or last-line line)))) + (when (< d jao-words-min-line-distance) + (when last-line + (cl-pushnew last-line lines) + (cl-pushnew line lines))) + (setq last-line line))))) + (mapconcat #'number-to-string (nreverse lines) " "))) + +;;;###autoload +(defun jao-words-show-stats () + (interactive) + (let ((counts (make-hash-table :test 'equal)) + (buffer (current-buffer))) + (seq-each (lambda (word) + (when (>= (length word) jao-words-min-length) + (puthash word (1+ (gethash word counts 0)) counts))) + (split-string (downcase (buffer-string)) "\\W+" t)) + (with-current-buffer (get-buffer-create "*word-statistics*") + (erase-buffer) + (insert "| word | occurences | lines | + |-----------+------------|--------------------|\n") + (maphash (lambda (word count) + (let ((lines (jao-words--word-lines buffer word))) + (insert (format "| %s | %d | %s |\n" word count lines)))) + counts) + (org-mode) + (org-table-goto-line 2) + (org-table-goto-column 2) + (org-table-sort-lines nil ?N) + (org-table-align) + (org-table-goto-line 2))) + (pop-to-buffer "*word-statistics*")) + + +(provide 'jao-words) +;;; jao-words.el ends here diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el index a5d9b24..b23e6af 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, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: frames @@ -19,10 +19,14 @@ ;; along with this program. If not, see <https://www.gnu.org/licenses/>. ;;; initialisation +(require 'multisession) (require 'cl-lib) (require 'jao-doc-session) +(require 'jao-pdf) (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) @@ -32,22 +36,57 @@ (defvar jao-afio--configs '(?c ?w ?g ?p ?s ?t)) (defvar jao-afio--previous-config (car jao-afio--configs)) +(defvar jao-afio--config-names + '((?c . "main") (?s . "scratch") (?g . "mail") + (?p . "docs") (?w . "web") (?t . "chats"))) + +(define-multisession-variable jao-afio-configurations nil) + +(defmacro jao-afio-add-frame-parameters (name &rest params) + `(add-to-list 'jao-afio-frame-parameters + '(,(if name (format "%s" name) 'def) ,params))) + +(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--init (&optional f) +(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 (or (assoc fn jao-afio-frame-parameters) + (assoc 'def 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 () (unless (jao-afio--current-config) (jao-afio--init (window-frame (get-buffer-window (current-buffer)))))) +(defvar jao-afio-side-buffers '("*eldoc*")) + ;;; utilities (defun jao-afio-trisect (&optional force) (interactive) @@ -61,7 +100,11 @@ (switch-to-buffer (other-buffer b)) (split-window-horizontally) (switch-to-buffer b) - (balance-windows))) + (balance-windows) + (when-let* ((b (seq-keep #'get-buffer jao-afio-side-buffers))) + (other-window -1) + (switch-to-buffer (car b)) + (other-window 1)))) ((> fw 162) (delete-other-windows) (split-window-horizontally) @@ -71,17 +114,18 @@ ;;;###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) (funcall jao-open-doc-fun doc) (find-file doc)) + (other-window 1))) + (other-window 1)) + +(defvar jao-afio-left-width nil) (defun jao-afio-open-doc () (interactive) (delete-other-windows) - (split-window-right) + (split-window-right jao-afio-left-width) (let ((docs (cl-remove-if-not 'jao-doc-session-is-doc (buffer-list)))) (if (car docs) (progn (switch-to-buffer (car docs)) @@ -101,6 +145,16 @@ (jao-eww-session-load))) ;;;###autoload +(defun jao-afio-org-agenda () + (interactive) + (org-agenda nil "j") + (when-let* ((w (get-buffer-window "*Org Agenda*"))) + (set-window-margins w 2 1) + (with-current-buffer (window-buffer w) + (setq-local cursor-in-non-selected-windows nil + line-spacing 0.2)))) + +;;;###autoload (defun jao-afio-open-www () (interactive) (require 'jao-eww-session) @@ -122,12 +176,13 @@ ;;;###autoload (defun jao-afio-open-gnus () (interactive) - (delete-other-windows) - (jao-org-agenda) + (jao-afio-org-agenda) (calendar) (find-file (expand-file-name "inbox.org" org-directory)) + (delete-other-windows) (gnus) - (jao-gnus--set-summary-line)) + ;; (jao-gnus--set-summary-line) + ) (defun jao-afio--mail-sidebar () (other-window 1) @@ -136,7 +191,7 @@ (set-window-dedicated-p nil t) (split-window-below (/ (window-height) 3)) (other-window 1) - (jao-org-agenda) + (jao-afio-org-agenda) (set-window-dedicated-p nil t) (split-window-below -8) (other-window 1) @@ -144,13 +199,22 @@ (set-window-dedicated-p nil t) (other-window 1)) +(defvar jao-afio-mail-sidebar-width 60) +(defvar jao-afio-mail-sidebar-right nil) + (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) + (let ((w (+ 3 jao-afio-mail-sidebar-width))) + (if jao-afio-mail-sidebar-right + (split-window-horizontally (- w)) + (split-window-horizontally w) + (other-window 1))) + (funcall fun) + ;; (set-window-dedicated-p nil t) + (jao-afio--mail-sidebar))) ;;;###autoload (defun jao-afio-open-mail () @@ -160,23 +224,30 @@ (t (jao-afio-trisect)))) ;;;###autoload +(defun jao-afio-toggle-mail-sidebar () + (interactive) + (setq jao-afio-mail-sidebar-right (not jao-afio-mail-sidebar-right)) + (jao-afio-open-mail)) + +;;;###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) (seq-find (lambda (f) (eq (jao-afio--current-config nil f) c)) (frame-list))) (defun jao-afio-frame-name (&optional c) - (alist-get (or c (jao-afio--current-config)) - '((?c . "main") (?s . "scratch") (?g . "mail") - (?p . "docs") (?w . "web") (?t . "chats")))) + (alist-get (or c (jao-afio--current-config)) jao-afio--config-names)) (defun jao-afio-frame-no (&optional c) (alist-get (or c (jao-afio--current-config)) @@ -195,16 +266,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 +298,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-borgmatic.el b/lib/eos/jao-borgmatic.el index f5d800d..6be370e 100644 --- a/lib/eos/jao-borgmatic.el +++ b/lib/eos/jao-borgmatic.el @@ -1,6 +1,6 @@ ;;; jao-borgmatic.el --- Simple access to borgmatic -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -116,8 +116,11 @@ (when (and (eq (process-status proc) 'exit) (y-or-n-p "Borg extraction finished, show?")) (if (eq (process-exit-status proc) 0) - (let ((d (file-name-directory (car paths)))) - (dired (expand-file-name d jao-borgmatic-extract-path))) + (let* ((d (file-name-directory (car paths))) + (p (expand-file-name d jao-borgmatic-extract-path))) + (if (file-exists-p p) + (dired p) + (message "%s is not in the archive" d))) (pop-to-buffer jao-borgmatic--extract-output))))) (defvar jao-borgmatic--extract-history nil) diff --git a/lib/eos/jao-buffers.el b/lib/eos/jao-buffers.el new file mode 100644 index 0000000..3339d33 --- /dev/null +++ b/lib/eos/jao-buffers.el @@ -0,0 +1,125 @@ +;;; jao-buffers.el --- deal with buffers and windows -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: files + +;; 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/>. + + +;;; deps +(require 'eldoc) + +;;; lines + +;;;###autoload +(defun jao-goto-visible-line (n) + (interactive "NGo to line: ") + (goto-char (point-min)) + (forward-visible-line n)) + +;;; windows +;;;###autoload +(defun transpose-windows (arg) + "Transpose the buffers shown in two windows." + (interactive "p") + (let ((selector (if (>= arg 0) 'next-window 'previous-window))) + (while (/= arg 0) + (let ((this-win (window-buffer)) + (next-win (window-buffer (funcall selector)))) + (set-window-buffer (selected-window) next-win) + (set-window-buffer (funcall selector) this-win) + (select-window (funcall selector))) + (setq arg (if (> arg 0) (1- arg) (1+ arg)))))) +;;; attached buffers +(defun jao-display-buffer-below-selected (buffer alist) + (delete-other-windows-vertically) + (display-buffer-below-selected buffer alist)) + +(defun jao-display-below-eldoc (buffer alist) + (let ((w (selected-window))) + (pop-to-buffer (eldoc-doc-buffer) nil t) + (jao-display-buffer-below-selected buffer alist) + (select-window w t))) + +(defun jao-attached-buffer-entry (name-rx height) + `(,name-rx (display-buffer-reuse-window + jao-display-buffer-below-selected) + (window-height . ,(or height 25)))) + +;;;###autoload +(defmacro jao-with-attached-buffer (name-rx height &rest body) + (declare (indent defun)) + `(let ((display-buffer-alist '(,(jao-attached-buffer-entry name-rx height)))) + ,@body)) + +;;;###autoload +(defun jao-define-attached-buffer (name-rx &optional height) + (add-to-list 'display-buffer-alist + (jao-attached-buffer-entry name-rx height))) + +;;; eldoc +;;;###autoload +(defun jao-eldoc-toggle () + "Toggle eldoc's documentation buffer." + (interactive) + (let ((buffer (eldoc-doc-buffer))) + (if-let* ((w (and buffer (get-buffer-window buffer)))) + (delete-window w) + (eldoc-doc-buffer t)))) + +;;;###autoload +(add-to-list 'display-buffer-alist + '("\\*eldoc\\( .*\\)?\\*" + (display-buffer-reuse-window) + (dedicated . t))) + +(defsubst jao-eldoc-window () (get-buffer-window (eldoc-doc-buffer))) + +;;;###autoload +(defun jao-clear-below-eldoc () + "Delete any windows below the eldoc buffer, if visible" + (interactive) + (unless (jao-eldoc-window) (jao-eldoc-toggle)) + (delete-other-windows-vertically (jao-eldoc-window))) + +;;;###autoload +(defun jao-attach-below-eldoc (rx &optional h) + (add-to-list 'display-buffer-alist + `(,rx + (display-buffer-reuse-window jao-display-below-eldoc) + (height . (or ,h 0.5))))) + +;;; same mode +;;;###autoload +(defun jao-buffer-same-mode (&optional mode pre-fn switch-fn) + (interactive) + (let* ((mode (or mode major-mode)) + (modes (if (symbolp mode) (list mode) mode)) + (pred `(lambda (b) + (let ((b (get-buffer (if (consp b) (car b) b)))) + (member (buffer-local-value 'major-mode b) + ',modes)))) + (buff (read-buffer "Buffer: " nil t pred))) + (when pre-fn (funcall pre-fn)) + (if switch-fn (funcall switch-fn buff) (switch-to-buffer buff)))) + +;;;###autoload +(defun jao-buffer-same-mode-cmd (&optional pop) + (interactive "P") + (jao-buffer-same-mode nil nil (and pop #'pop-to-buffer))) + +(provide 'jao-buffers) +;;; jao-buffers.el ends here diff --git a/lib/eos/jao-dirmon.el b/lib/eos/jao-dirmon.el index 9d748d1..261433d 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, 2026 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 -1) + (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)))) @@ -51,7 +60,8 @@ (dolist (c (seq-take-while (lambda (x) (> (cdr x) threshold)) (seq-sort-by #'cdr #'> current))) (insert (format "- %s: %s Mb\n" (car c) (cdr c))))) - (beginning-of-buffer) + (goto-char (point-min)) + (view-mode 1) (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-eshell-here.el b/lib/eos/jao-eshell-here.el index ad7805f..8733cb9 100644 --- a/lib/eos/jao-eshell-here.el +++ b/lib/eos/jao-eshell-here.el @@ -1,6 +1,6 @@ ;;; jao-eshell-here.el --- Easy opening of eshell buffers -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2023, 2024 jao +;; Copyright (C) 2021, 2023, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: eshell @@ -25,6 +25,11 @@ ;;; Code: (require 'eshell) +(require 'esh-mode) +(require 'em-dirs) +(require 'jao-buffers) +(require 'project) + (defvar jao-eshell-here-display-buffer-alist '(("^\\*eshell" diff --git a/lib/eos/jao-mac.el b/lib/eos/jao-mac.el new file mode 100644 index 0000000..2312c6c --- /dev/null +++ b/lib/eos/jao-mac.el @@ -0,0 +1,269 @@ +;;; jao-mac.el --- Running applescript. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025, 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: lisp + +;; 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 'thingatpt) +(require 'jao-shell) + +;;; applescript +(defun jao-mac-applescript-prepare (&rest lines) + (let ((script (mapconcat 'identity lines "\r")) + (start)) + (while (string-match "\n" script) + (setq script (replace-match "\r" t t script))) + (while (string-match "'" script start) + (setq start (+ 2 (match-beginning 0)) + script (replace-match "\\'" t t script))) + script)) + +(defun jao-mac-run-applescript (script) + (string-trim (shell-command-to-string (format "osascript -e '%s'" script)))) + +(defun jao-mac-run-applescript* (&rest lines) + (jao-mac-run-applescript (apply #'jao-mac-applescript-prepare lines))) + +(defun jao-mac-tell-app (app &rest script-lines) + (let* ((app-id (string-split app)) + (id (if (> (length app-id) 1) (car app-id) "")) + (app (if (> (length app-id) 1) (cadr app-id) (car app-id))) + (pre (list (format "tell application %s %S" id app))) + (post '("end tell\n"))) + (apply #'jao-mac-run-applescript* (append pre script-lines post)))) + +;;; open + +;;;###autoload +(defun jao-mac-open (thing &rest args) + "Invoke open after formatting thing with args, using `format'" + (jao-shell-exec (format "open %s" (apply #'format thing args)))) + +;;; notifications + +(defun jao-mac-notify (title subtitle msg) + (jao-mac-run-applescript* + (format "display notification %S with title %S subtitle %S" + msg title subtitle))) + +(defun jao-mac-app-badge (app) + "A very hacky, yet efficient, way of getting and apps badge." + (let* ((c (format "lsappinfo info -app %S -only StatusLabel" app)) + (s (shell-command-to-string c))) + (when (string-match ".*=\"\\([0-9]+\\)\" ." s) + (string-to-number (match-string 1 s)))) ) + +;;; Preview + +(declare-function 'doc-view-current-page "doc-view") + +;; https://alvinalexander.com/macos/applescript-how-to-open-pdf-file-in-preview-go-to-page/ +;; This will work as long as Preview is the default app for the file at hand. +;;;###autoload +(defun jao-mac-open-in-preview (&optional file page _height) + (interactive) + (let ((file (if file (expand-file-name file) (buffer-file-name))) + (page (or page (and (derived-mode-p 'doc-view-doc) + (doc-view-current-page))))) + (jao-mac-run-applescript* + (format "tell application id \"com.apple.Preview\" to open (POSIX file %S)\r\r" + (file-truename file)) + "delay 1" + "tell application \"System Events\"" + "keystroke \"g\" using {option down, command down}" + (format "keystroke %s" (or page 1)) + "delay 0.1\rkeystroke return\rend tell"))) + + +;;; Dict + +(defvar jao-mac-dict-history nil) + +(defun jao-mac-dict (&optional word) + (interactive (list (thing-at-point 'word))) + (jao-mac-open "dict://%S" + (read-string (format "Look up (%s): " word) + nil + 'jao-mac-dict-history + (substring-no-properties word) + t))) + +;;; Skim +(defvar jao-skim--current-file-script + (jao-mac-applescript-prepare + "tell application \"Skim\"" + " try" + " set theD to front document" + " set theP to (path of theD)" + " set thePg to (get index of current page of theD)" + " return (theP & \"::\" & thePg)" + " on error" + " return \"\"" + " end try" + "end tell")) + +(defun jao-skim-current-doc () + "Returns a list of path and page number for the current Skim doc." + (when-let* ((p (jao-mac-run-applescript jao-skim--current-file-script)) + (p (and (not (string-blank-p p)) p))) + (let ((ps (split-string p "::"))) + (list (car ps) (string-to-number (cadr ps)))))) + +(defun jao-skim-open-current-doc () + (interactive) + (when-let* ((ps (jao-skim-current-doc))) + (apply 'jao-open-doc ps))) + +(defvar jao-skim--current-page-text + (jao-mac-applescript-prepare + "tell application \"Skim\"" + "return the text of the current page of the front document" + "end tell")) + +(defun jao-skim-page-text () + (jao-mac-run-applescript jao-skim--current-page-text)) + +;;;###autoload +(defun jao-skim-view-page-text () + (interactive) + (when-let* ((ps (jao-skim-current-doc)) + (p (car ps)) + (n (cadr ps)) + (txt (jao-skim-page-text)) + (bn (format "*%s - %s - txt*" p n))) + (with-current-buffer (get-buffer-create bn) + (delete-region (point-min) (point-max)) + (insert txt) + (pop-to-buffer (current-buffer))))) + +(defun jao-pdf-skim-org-link (title) + (when-let* ((fp (jao-skim-current-doc)) + (file (file-name-nondirectory (car fp))) + (page (cadr fp)) + (lnk (format "doc:%s::%s" file page))) + (org-link-make-string lnk title))) + +;;;###autoload +(defun jao-mac-open-in-skim (&optional file page _height) + (interactive) + (let* ((file (if file (expand-file-name file) (buffer-file-name))) + (page (or page (and (derived-mode-p 'doc-view-mode) + (doc-view-current-page))))) + (jao-mac-open "skim://%s%s" file (if page (format "#page=%s" page) "")))) + +;;;###autoload +(defun jao-pdf-insert-skim-org-link () + (interactive) + (if-let* ((title (read-string "Title: ")) + (lnk (jao-pdf-skim-org-link title))) + (insert lnk) + (user-error "Skim is not viewing any docs!"))) + +;;; NetNewsWire + +(defvar jao-nnw--current-article-script + (jao-mac-applescript-prepare + "tell application \"NetNewsWire\"" + "try" + "return (the url of the current article)" + "on error" + "return \"\"" + "end try" + "end tell")) + +(defun jao-nnw-current-article () + "The URL of the current article in NetNewsWire" + (jao-mac-run-applescript jao-nnw--current-article-script)) + +(defun jao-nnw-browse-current-article () + "Browse the URL of the current NNW article." + (interactive) + (if-let* ((url (jao-nnw-current-article))) + (unless (string-empty-p url) + (browse-url url)) + (message "No article selected in NetNewsWire"))) + +(defvar jao-nnw--label-cmd + "lsappinfo info -app NetNewsWire -only StatusLabel") + +(defun jao-nnw-unread-count () + (jao-mac-app-badge "NetNewsWire")) + +(defun jao-mac-open-nnw () + (interactive) + (jao-mac-open "-a NetNewsWire")) + +;;; Safari +(defun jao-safari-current-url () + (jao-mac-tell-app "Safari" "return URL of current tab of window 1")) + +(defun jao-safari-browse-current () + "Browse the URL of the current Safari topmost document." + (interactive) + (browse-url (jao-safari-current-url))) + +;;; Firefox +(defvar jao-ffox--current-url-script + (jao-mac-applescript-prepare + "tell application \"Firefox\"" + " activate" + " delay 0.15" + " tell application \"System Events\"" + " keystroke \"l\" using command down" + " delay 0.20" + " keystroke \"c\" using command down" + " end tell" + " delay 0.5" + "end tell" + "return the clipboard")) + +(defun jao-firefox-current-url () + (let ((res (jao-mac-run-applescript jao-ffox--current-url-script))) + (jao-mac-run-applescript "tell application \"Emacs\" to activate") + res)) + +(defun jao-firefox-open () + (interactive) + (jao-mac-open "-a Firefox")) + +;;; DevonThink + +;; (defun jao-devon-tell (&rest script-lines) +;; (apply #'jao-mac-tell-app "id DNtp" script-lines )) + +;; (defun jao-devon-find-url (file) +;; (jao-devon-tell +;; "repeat with db in databases" +;; (format "set res to lookup records with path %S in db" +;; (file-truename file)) +;; "if res /= {} then return the reference URL of (item 1 of res)" +;; "end repeat" +;; "return \"\"")) + +;; (defun jao-devon-show-search (s) +;; (jao-devon-tell (format "show search %S" s) "activate")) + +;; (defun jao-devon-open (file &optional page height) +;; (let ((url (jao-devon-find-url file))) +;; (if (string-empty-p (or url "")) +;; (let ((jao-pdf-open-in-emacs t)) +;; (jao-find-or-open file page height)) +;; (let ((p (if page (format "?page=%s" (- page 1)) ""))) +;; (jao-mac-open "%s%s" url p))))) + +(provide 'jao-mac) +;;; jao-mac.el ends here diff --git a/lib/eos/jao-minibuffer.el b/lib/eos/jao-minibuffer.el index d2bc70a..8f8996e 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, 2026 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)) @@ -79,8 +81,9 @@ (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-notify.el b/lib/eos/jao-notify.el index 623b8cc..c1efb58 100644 --- a/lib/eos/jao-notify.el +++ b/lib/eos/jao-notify.el @@ -1,6 +1,6 @@ -;; jao-notify.el -- Interacting with notification daemon +;; jao-notify.el -- Interacting with notification daemon -*- lexical-binding: t; -*- -;; Copyright (c) 2017, 2019, 2020, 2021, 2024 Jose Antonio Ortega Ruiz +;; Copyright (c) 2017, 2019, 2020, 2021, 2024, 2025, 2026 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sun Jan 08, 2017 20:24 @@ -14,24 +14,33 @@ (defvar jao-notify-use-messages nil) (defvar jao-notify-timeout 5000) -(defvar jao-notify-audio-icon (jao-data-file "music-player-icon.png")) +(defvar jao-notify-audio-icon nil) (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-shell.el b/lib/eos/jao-shell.el index 86bf46b..8745492 100644 --- a/lib/eos/jao-shell.el +++ b/lib/eos/jao-shell.el @@ -1,6 +1,6 @@ ;;; jao-shell.el --- shell utils -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: shell @@ -18,11 +18,70 @@ ;; 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: - -;; shell helpers - -;;; Code: +(require 'term) + +;;; term +;;;###autoload +(defvar jao-use-vterm nil) + +;;;###autoload +(defvar jao-use-eat nil) + +(defvar-local jao-term--cmd nil) + +(defvar-local jao-term--cmd nil) + +(defun jao-term--find (cmd) + (seq-find (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'eat-mode 'term-mode 'vterm-mode) + (string= (or jao-term--cmd "") cmd)))) + (buffer-list))) + +(declare-function vterm nil) +(declare-function vterm-mode nil) +(defvar vterm-shell) +(defvar vterm-kill-buffer-on-exit) + +(defun jao-exec-in-vterm (cmd bname &optional no-kill) + (if (string-blank-p (or cmd "")) + (vterm) + (let ((vterm-shell cmd) + (vterm-kill-buffer-on-exit (not no-kill)) + (buff (generate-new-buffer bname))) + (switch-to-buffer buff) + (vterm-mode)))) + +;;;###autoload +(defun jao-exec-in-term (cmd &optional name no-kill) + (interactive "SCommand") + (require 'eat nil t) + (cond ((and jao-use-vterm (fboundp 'jao-exec-in-vterm)) + (jao-exec-in-vterm cmd name no-kill)) + ((and jao-use-eat (fboundp 'eat)) + (let ((eat-term-name "xterm-256color")) + (with-current-buffer (eat cmd t) + (setq-local jao-term--cmd cmd)))) + (t (ansi-term "bash" name) + (unless no-kill + (set-process-sentinel (get-buffer-process (current-buffer)) + (lambda (process event) + (when (string= event "finished\n") + (kill-buffer (process-buffer process)))))) + (setq-local jao-term--cmd cmd) + (term-send-string nil (format "%s%s\n" cmd (if no-kill "" ";exit")))))) + +;;;###autoload +(defmacro jao-def-exec-in-term (name cmd &rest prelude) + `(defun ,(intern (format "jao-term-%s" name)) (&optional term) + (interactive "P") + ,@prelude + (let ((jao-use-vterm (if term (not jao-use-vterm) jao-use-vterm))) + (if-let* ((b (jao-term--find ,cmd))) + (pop-to-buffer b) + (jao-exec-in-term ,cmd ,(format "*%s*" name)))))) + +;;; shell (defun jao-shell-cmd-lines (cmd &rest args) (let ((cmd (concat cmd " " (combine-and-quote-strings args)))) @@ -59,11 +118,12 @@ (defun jao-shell-output (cmd handler) (with-temp-buffer (call-process-shell-command cmd nil (current-buffer)) - (beginning-of-buffer) + (goto-char (point-min)) (funcall handler))) (defun jao-shell-running-p (pr) (eq 0 (jao-shell-exec* t "pidof" pr))) (defun jao-shell-kill-p (pr) (eq 0 (jao-shell-exec* t "killall" pr))) (provide 'jao-shell) + ;;; jao-shell.el ends here diff --git a/lib/eos/jao-sleep.el b/lib/eos/jao-sleep.el index b047373..3b46031 100644 --- a/lib/eos/jao-sleep.el +++ b/lib/eos/jao-sleep.el @@ -1,6 +1,6 @@ ;;; jao-sleep.el --- Actions upon sleep/awake -*- lexical-binding: t; -*- -;; Copyright (C) 2020 jao +;; Copyright (C) 2020, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: hardware @@ -25,7 +25,7 @@ (defvar jao-sleep-sleep-functions nil) (defvar jao-sleep-awake-functions nil) -(defvar jao-sleep--dbus-registration-object nil) +(defvar jao-sleep--dbus-sleep-registration-object nil) (defun jao-sleep--dbus-sleep-handler (sleep-start) (condition-case nil diff --git a/lib/themes/jao-themes.el b/lib/eos/jao-themes.el index 706427b..ed4d038 100644 --- a/lib/themes/jao-themes.el +++ b/lib/eos/jao-themes.el @@ -19,10 +19,17 @@ ;;; Code: (require 'ansi-color) +(require 'cl) ;;; palette -(defvar jao-themes-default-face "DejaVu Sans Mono-9") -(defvar jao-themes--face-family "DejaVu Sans Mono") +(defvar jao-themes-default-face nil) +(defvar jao-themes-default-family "Hack") +(defvar jao-themes-default-variable-pitch-size 9) +(defvar jao-themes-default-variable-pitch-family "Hack") +(defvar jao-themes-default-size 9) +(defvar jao-themes--face-family jao-themes-default-face) +(defvar jao-themes--variable-pitch-family nil) +(defvar jao-themes--variable-pitch-height nil) (defvar jao-themes--fg "black") (defvar jao-themes--bg "white") (defvar jao-themes--box "grey75") @@ -62,6 +69,10 @@ (defvar jao-themes--f11 '((c "cadetblue4"))) (defvar jao-themes--f12 '((c "darkslategrey"))) +(defgroup jao-themes-faces nil + "Faces for unified custom themes" + :group 'faces) + (defface jao-themes-hilite '((t :inherit default)) "") (defface jao-themes-italic '((t :inherit default)) "") (defface jao-themes-button '((t :inherit default)) "") @@ -112,6 +123,10 @@ (jao-themes--normalize-body (apply 'append (mapcar 'jao-themes--parse-face-sym f)))))) +(defsubst jao--put-face (str face) + (put-text-property 0 (length str) 'face face str) + str) + (defvar jao-themes--default-cidxs '("#000000" "#cd0000" "#00cd00" "#cdcd00" "#0000cd" "#cd00cd" "#00cdcd" "#e5e5e5" @@ -318,9 +333,9 @@ (avy-lead-face-0 (~ avy-lead-face) bf) (avy-lead-face-1 (~ avy-lead-face))) `((bbdb-company) - (bbdb-field-name bf) + (bbdb-field-name (p f00)) (bbdb-field-value (~ default)) - (bbdb-name ul) + (bbdb-name (p f01)) (bmk-mgr-bookmark-face (~ default)) (bmk-mgr-folder-face bf) (bmk-mgr-sel-bookmark-face link) @@ -597,7 +612,11 @@ (font-lock-type-face (p type)) (font-lock-variable-name-face (p variable-name)) (font-lock-warning-face (p warning)) + (forge-pullreq-merged (p dimm)) (forge-pullreq-open (c nil nil)) + (forge-pullreq-rejected (~ forge-pullreq-merged) st) + (forge-topic-pending (c nil nil)) + (forge-topic-unread (p f00)) (forge-topic-label bx) (fringe (p dimm)) (fuel-font-lock-debug-error (p error) nul) @@ -958,7 +977,7 @@ (org-table (p f01)) (org-tag (p dimm) nbf) (org-target ul) - (org-time-grid (c nil nil)) + (org-time-grid (p dimm)) (org-todo nbf niv (p error)) (org-upcoming-deadline (p f02)) (org-verbatim (p hilite)) @@ -1077,6 +1096,7 @@ (sunshine-forecast-date-face (~ default)) (sunshine-forecast-day-divider-face (p dimm)) (sunshine-forecast-headline-face (~ header-line)) + (switch-window-label-face (p keyword) :height 2.0) (symbol-overlay-face-1 (c nil "brown1")) (symbol-overlay-face-2 (c nil "lightsalmon1")) (symbol-overlay-face-3 (c nil "tomato1")) @@ -1106,7 +1126,7 @@ (twittering-uri-face (~ link)) (twittering-username-face (p f01))) `((underline ul)) - `((variable-pitch :family ,jao-themes--face-family) + `((variable-pitch :family ,jao-themes--variable-pitch-family) (variable-pitch-text (~ variable-pitch)) (vertical-border (c ,jao-themes--box nil) :inherit default) (vertico-current (p hilite)) @@ -1221,25 +1241,37 @@ (cons kind f-alist) (assq-delete-all kind window-system-default-frame-alist))))) +;;;###autoload (defmacro jao-define-custom-theme (name &rest args) (let ((palette (cdr (assoc :palette args))) (x-faces (cdr (assoc :x-faces args))) (x-colors (cdr (assoc :x-colors args))) - (family (cadr (assoc :face-family args))) - (size (or (cadr (assoc :face-size args)) 9)) + (family (or (cadr (assoc :face-family args)) + jao-themes-default-family)) + (size (or (cadr (assoc :face-size args)) + jao-themes-default-size)) + (vpitch (or (cadr (assoc :variable-pitch-family args)) + jao-themes-default-variable-pitch-family)) + (vsize (or (cadr (assoc :variable-pitch-size args)) + jao-themes-default-variable-pitch-size)) (bw (or (cadr (assoc :bold-weight args)) jao-themes--bold-weight))) `(progn (custom-make-theme-feature ',name) (deftheme ,name) (custom-theme-set-variables ',name '(jao-themes-default-face - (format "%s-%s" ,family ,size)) + ,(format "%s-%s" family size)) '(jao-themes--face-family ,family) + '(jao-themes--variable-pitch-family + ,vpitch) + '(jao-themes--variable-pitch-height + ,(* 10 vsize)) '(jao-themes--bold-weight ,bw)) (let ((*jao-themes--color-names* ',(cdr (assoc :names args))) (jao-themes--face-family ,family)) (let* ,(jao-themes--let-palette palette) (jao-themes--set-fbg 'x) + (jao-themes--set-fbg 'ns) (jao-themes--set-fbg 'pgtk) (let* ((xfaces (jao-themes--make-faces ',x-faces ',x-colors)) (tx-faces (jao-themes--extract-faces xfaces xfaces))) diff --git a/lib/eos/jao-tracking.el b/lib/eos/jao-tracking.el index a1fff73..b8514c8 100644 --- a/lib/eos/jao-tracking.el +++ b/lib/eos/jao-tracking.el @@ -1,6 +1,6 @@ ;; jao-minibuffer-tracking.el --- Tracking notifications -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022, 2024 jao +;; Copyright (C) 2021, 2022, 2024, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -25,6 +25,10 @@ (require 'jao-minibuffer) (require 'jao-afio) +;;; frame tracking for exwm +(with-eval-after-load 'tracking + (add-hook 'exwm-workspace-switch-hook 'tracking-remove-visible-buffers)) + ;;; shorten ;;;###autoload (defun jao-shorten-modes (&rest modes) @@ -87,13 +91,13 @@ (defvar jao-tracking--pipe (let ((name "/tmp/emacs.status")) (unless (file-exists-p name) - (shell-command (format "mkfifo %s" name name))) + (shell-command (format "mkfifo %s" name))) name)) (defun jao-tracking-set-log (v) - (when (member window-system '(x)) + (when (fboundp 'x-change-window-property) (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0)) - (if jao-wayland-enabled + (if (bound-and-true-p jao-wayland-enabled) (let ((inhibit-message t)) (shell-command (format "echo \"%s\" > %s" v jao-tracking--pipe))) (let* ((action (if (string-blank-p v) "remove" "add")) diff --git a/lib/eos/jao-weather.el b/lib/eos/jao-weather.el new file mode 100644 index 0000000..50dc56a --- /dev/null +++ b/lib/eos/jao-weather.el @@ -0,0 +1,39 @@ +;;; jao-weather.el --- weather utils -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 jao + +;; Author: jao <mail@jao.io> + +;; 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-afio) +(require 'jao-shell) +(require 'term) + +;;; winttr +;;;###autoload +(defun jao-weather (&optional wide) + (interactive "P") + (if (not wide) + (message "%s" + (jao-shell-string "curl -s" + "https://wttr.in/?format=%l++%m++%C+%c+%t+%w++%p")) + (jao-afio-goto-scratch) + (if-let* ((b (get-buffer "*wttr*"))) + (progn (pop-to-buffer b) + (term-send-string (get-buffer-process nil) "clear;curl wttr.in\n")) + (jao-exec-in-term "curl wttr.in" "*wttr*" t)))) + +(provide 'jao-weather) +;;; jao-weather.el ends here diff --git a/lib/media/jao-lyrics.el b/lib/media/jao-lyrics.el index 985c9d9..c00a913 100644 --- a/lib/media/jao-lyrics.el +++ b/lib/media/jao-lyrics.el @@ -1,6 +1,6 @@ -;; jao-lyrics.el -- simple show lyrics using glyrc +;; jao-lyrics.el -- simple show lyrics using glyrc -*- lexical-binding: t; -*- -;; Copyright (C) 2009, 2010, 2017, 2019, 2020, 2022 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2017, 2019, 2020, 2022, 2026 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sat Jul 04, 2009 13:41 @@ -99,8 +99,13 @@ "^\\(CreditsWritten by:\\|External linksNominate\\)" nil t) (beginning-of-line) (kill-region (point) (point-max))) - (replace-string "
" "" nil (point-min) (point-max)) - (replace-string "\\'" "'" nil (point-min) (point-max)) + (goto-char (point-min)) + (save-excursion + (while (search-forward "
" nil t) + (replace-match ""))) + (save-excursion + (while (search-forward "\\'" nil t) + (replace-match "'"))) (save-buffer))) (defun jao-lyrics--download (artist title &optional noartist) @@ -115,7 +120,7 @@ (jao-lyrics--clean-download fn) (prog1 (jao-lyrics--get-cached artist title) (message nil)))) -(defvar jao-lyrics-info-function) +(defvar jao-lyrics-info-function nil) (defvar-local jao-lyrics--info-function nil) ;;;###autoload diff --git a/lib/media/jao-mpc.el b/lib/media/jao-mpc.el index ab8823f..6c5fffd 100644 --- a/lib/media/jao-mpc.el +++ b/lib/media/jao-mpc.el @@ -1,6 +1,6 @@ ;;; jao-mpc.el --- Using mpc to interact with mpd -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022, 2024 jao +;; Copyright (C) 2021, 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -30,6 +30,8 @@ (require 'jao-themes) (require 'jao-lyrics) (require 'jao-random-album) +(require 'jao-notify) +(require 'jao-minibuffer) (defconst jao-mpc--albums "*MPC Albums*") (defconst jao-mpc--playlist "*MPC Playlist*") @@ -46,11 +48,12 @@ (mapconcat (lambda (f) (format "%s:::%%%s%%" f f)) fields "\n")) (defconst jao-mpc--fields - '(artist album composer originaldate genre title track position time name)) + '(artist album composer originaldate genre title track position time name + file)) (defconst jao-mpc--stfmt (jao-mpc--fformat - '(artist album composer originaldate genre title track name))) + '(artist album composer originaldate genre title track name file))) (defconst jao-mpc--stfmtt (jao-mpc--fformat '(currenttime totaltime percenttime songpos length))) @@ -76,19 +79,17 @@ (defsubst jao-mpc--queue-len (&optional port) (string-to-number (jao-mpc--cmd "status %length%" port))) -(defsubst jao--put-face (str face) - (put-text-property 0 (length str) 'face face str) - str) - (defun jao-mpc--current-timestr (playing-times &optional current) (let* ((current (or current (jao-mpc--current))) - (time (alist-get 'totaltime current ""))) + (time (alist-get 'totaltime current "")) + (remaining (jao-mpc-playlist-duration-string current))) (if playing-times - (format "%s/%s%s" + (format "%s/%s%s - %s" (alist-get 'currenttime current "") time - (alist-get 'percenttime current "")) - (format "%s" time)))) + (alist-get 'percenttime current "") + remaining) + (format "%s - %s" time remaining)))) (defun jao-mpc--current-str (&optional port times) (if-let* ((current (jao-mpc--current port)) @@ -106,7 +107,8 @@ (jao--put-face (or 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) + (jao--put-face (if album (format " (%s)" album) "") + 'jao-themes-f11) (jao--put-face tims (if times 'jao-themes-f00 'jao-themes-dimm)))) "")) @@ -131,9 +133,11 @@ (make-process :name (format "jao-mpc-idleloop (%s)" port) :buffer nil :noquery t - :command `("mpc" "-p" ,(format "%s" (or port jao-mpc-port)) - "idleloop" "player") - :filter (lambda (_p _s) (jao-mpc--set-current-str port))))) + :command + `("mpc" "-p" ,(format "%s" (or port jao-mpc-port)) + "idleloop" "player") + :filter (lambda (_p _s) + (jao-mpc--set-current-str port))))) (defvar jao-mpc--browser-port nil) @@ -157,7 +161,8 @@ (let ((a (or album (string-trim (thing-at-point 'line)))) (p (or port jao-mpc--browser-port))) (jao-mpc--cmd "clear" p) - (jao-mpc--cmd (if idp (concat "add " a) (format "findadd album \"%s\"" a)) p) + (jao-mpc--cmd (if idp (concat "add " a) (format "findadd album \"%s\"" a)) + p) (jao-mpc--cmd "play" p))) (define-key jao-mpc-albums-mode-map (kbd "n") #'next-line) @@ -190,7 +195,8 @@ (define-key jao-mpc-playlist-mode-map (kbd "n") #'next-line) (define-key jao-mpc-playlist-mode-map (kbd "p") #'previous-line) (define-key jao-mpc-playlist-mode-map (kbd "q") #'bury-buffer) -(define-key jao-mpc-playlist-mode-map (kbd ".") #'jao-mpc--playlist-goto-current) +(define-key jao-mpc-playlist-mode-map (kbd ".") + #'jao-mpc--playlist-goto-current) (define-key jao-mpc-playlist-mode-map (kbd "RET") #'jao-mpc--playlist-play) (define-key jao-mpc-playlist-mode-map (kbd "C") #'jao-mpc-clear) @@ -206,6 +212,31 @@ (accept-process-output nil 0.5) (setq jao-random-album-active st))) +(defun jao-mpc--time-to-secs (str) + (if-let* ((ts (string-split (or str "") ":")) + (mins (string-to-number (car ts))) + (secs (string-to-number (or (cadr ts) "0")))) + (+ secs (* 60 mins)) + 0)) + +(defun jao-mpc--playlist-duration (&optional current port) + (let* ((current (or current (jao-mpc--current))) + (times (string-split (jao-mpc--cmd "playlist -f %time%") nil t)) + (offset (- (string-to-number (alist-get 'songpos current "1")) 1)) + (times (drop offset times)) + (total (- (jao-mpc--time-to-secs (alist-get 'currenttime current))))) + (dolist (time times total) + (setq total (+ total (jao-mpc--time-to-secs time)))))) + +;;;###autoload +(defun jao-mpc-playlist-duration-string (&optional current fmt) + (format-seconds (or fmt "%hh %mm %ss") (jao-mpc--playlist-duration current))) + +;;;###autoload +(defun jao-mpc-show-playlist-duration () + (interactive) + (message (jao-mpc-playlist-duration-string))) + ;;;###autoload (defun jao-mpc-stop (&optional port) (interactive) @@ -217,6 +248,11 @@ (jao-mpc--with-delayed-random-album "toggle" port)) ;;;###autoload +(defun jao-mpc-pause (&optional port) + (interactive) + (jao-mpc--with-delayed-random-album "pause" port)) + +;;;###autoload (defun jao-mpc-play (&optional port) (interactive) (jao-mpc--cmd "play" port)) @@ -247,11 +283,28 @@ (message "%s" (jao-mpc--current-str port t))) ;;;###autoload -(defun jao-mpc-echo-current-times (&optional port) +(defun jao-mpc-echo-current-times (&optional _port) (interactive) (message "Playing time: %s" (jao-mpc--current-timestr t))) ;;;###autoload +(defun jao-mpc-notify (&optional _port) + (interactive) + (when-let* ((current (jao-mpc--current))) + (let* ((artist (or (alist-get 'artist current) "Anonymous")) + (title (or (alist-get 'title current) + (when-let* ((tl (alist-get 'file current))) + (file-name-base tl)) + "")) + (album (or (alist-get 'album current) "")) + (track (or (alist-get 'track current) "")) + (times (jao-mpc--current-timestr t current))) + (jao-notify (format "%s -- %s" artist times) + (format "%s %s" track title) + jao-notify-audio-icon + album)))) + +;;;###autoload (defun jao-mpc-add-url (url) (interactive "sURL: ") (jao-mpc--cmd (format "add %s" url))) diff --git a/lib/media/jao-mpris.el b/lib/media/jao-mpris.el index f2974ab..c120ae3 100644 --- a/lib/media/jao-mpris.el +++ b/lib/media/jao-mpris.el @@ -1,6 +1,6 @@ ;;; jao-mpris.el --- mpris players control -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022, 2024 jao +;; Copyright (C) 2020, 2021, 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: multimedia @@ -51,10 +51,9 @@ (interactive "p") (jao-mpris-seek (- secs))) -(defun jao-mpris-vol (n) +(defun jao-mpris-vol (vol) (interactive "p") - (let ((secs (if (zerop n) 10 n))) - (jao-mpris--playerctl "volume" (format "%d" n)))) + (jao-mpris--playerctl "volume" (format "%d" (if (zerop vol) 10 vol)))) (defun jao-mpris-vol-down (n) (interactive "p") @@ -146,9 +145,10 @@ (interactive "P") (when refresh (jao-mpris--track)) (when jao-mpris--current - (jao-notify (format "%s%s" (if-let* ((s (jao-mpris--get 'status))) - (format "%s: " s) - "") + (jao-notify (format "%s%s" + (if-let* ((s (jao-mpris--get 'status))) + (format "%s: " s) + "") (jao-mpris--format))))) (defun jao-mpris-minibuffer-order (order) @@ -158,26 +158,25 @@ (defun jao-mpris--handler (iname properties &rest _args) (let ((inhibit-message t)) - (message "Received properties: %S from %s" properties iname)) - (when-let* ((md (caadr (assoc "Metadata" properties)))) - (let ((tno (caadr (assoc "xesam:trackNumber" md))) - (tlt (caadr (assoc "xesam:title" md))) - (art (caadr (assoc "xesam:artist" md))) - (alb (caadr (assoc "xesam:album" md))) - (len (caadr (assoc "mpris:length" md)))) - (if (string= (or tlt "") "TIDAL") - (jao-mpris-reset) + (message "Received properties: %S from %s" properties iname) + (when-let* ((md (caadr (assoc "Metadata" properties)))) + (let ((tno (caadr (assoc "xesam:trackNumber" md))) + (tlt (caadr (assoc "xesam:title" md))) + (art (caadr (assoc "xesam:artist" md))) + (alb (caadr (assoc "xesam:album" md))) + (len (caadr (assoc "mpris:length" md)))) (jao-mpris--set-current 'track tno) (jao-mpris--set-current 'title tlt) (jao-mpris--set-current 'artist art) (jao-mpris--set-current 'album alb) - (jao-mpris--set-current 'length len)))) - (when-let* ((st (or (caadr (assoc "PlaybackStatus" properties)) - (jao-mpris--get 'status)))) - (jao-mpris--set-current 'status st) - (when (string= st "Stopped") - (dolist (k '(track title artist album length)) - (jao-mpris--del-current k)))) + (jao-mpris--set-current 'length len))) + (when-let* ((st (caadr (assoc "PlaybackStatus" properties)))) + (jao-mpris--set-current 'status st) + (when (string= st "Stopped") + (dolist (k '(track title artist album length)) + (jao-mpris--del-current k)))) + ;; (message "Current is: %S" jao-mpris--current) + ) (jao-mpris--track jao-mpris--current)) ;;;###autoload diff --git a/lib/media/jao-random-album.el b/lib/media/jao-random-album.el index 3b2915b..540f6a6 100644 --- a/lib/media/jao-random-album.el +++ b/lib/media/jao-random-album.el @@ -1,6 +1,6 @@ -;; jao-random-album.el -- play random albums +;; jao-random-album.el -- play random albums -*- lexical-binding: t; -*- -;; Copyright (C) 2009, 2010, 2017-2019, 2021-2022, 2024 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2017-2019, 2021-2022, 2024, 2026 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sat Jul 04, 2009 13:06 @@ -18,35 +18,33 @@ ;; 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 'multisession) + (defvar jao-random-album-active t) -(defvar jao-random-lines nil) -(defvar jao-random-lines-file (expand-file-name "~/.emacs.d/random-lines")) (defvar jao-random-album-notify nil) (defvar jao-random-album-skip-lines 2) +(define-multisession-variable jao-random-lines nil) + +(defun jao-random-album--buffer-lines () + (let ((lines nil)) + (dotimes (n (1- (line-number-at-pos (point-max)))) + (when (> n jao-random-album-skip-lines) + (push (1+ n) lines))) + lines)) + (defun jao-random-lines () - (or jao-random-lines - (and (file-exists-p jao-random-lines-file) - (with-current-buffer - (find-file-noselect jao-random-lines-file) - (goto-char (point-min)) - (setq jao-random-lines (read (current-buffer))))) - (dotimes (n (1- (line-number-at-pos (point-max))) - jao-random-lines) - (when (> n jao-random-album-skip-lines) - (push (1+ n) jao-random-lines))))) - -(defun jao-random-lines-save () - (with-current-buffer (find-file-noselect jao-random-lines-file) - (delete-region (point-min) (point-max)) - (insert (format "%s\n" jao-random-lines)) - (save-buffer))) + (or (multisession-value jao-random-lines) + (jao-random-lines-save (jao-random-album--buffer-lines)))) + +(defun jao-random-lines-save (v) + (setf (multisession-value jao-random-lines) v)) (defun jao-goto-random-album () - (let* ((pos (random (length (jao-random-lines)))) - (line (nth pos jao-random-lines))) - (setq jao-random-lines (remove line jao-random-lines)) - (jao-random-lines-save) + (let* ((lines (jao-random-lines)) + (pos (random (length lines))) + (line (nth pos lines))) + (jao-random-lines-save (remove line lines)) (goto-line line))) @@ -55,22 +53,26 @@ (defvar jao-random-album-add-tracks-and-play) (defvar jao-random-album-stop) +;;;###autoload (defun jao-random-album-start () (interactive) (setq jao-random-album-active t) (jao-random-album-next)) +;;;###autoload (defun jao-random-album-stop () (interactive) (setq jao-random-album-active nil) (funcall jao-random-album-stop)) +;;;###autoload (defun jao-random-album-toggle () (interactive) (setq jao-random-album-active (not jao-random-album-active)) (message "Random album %s" (if jao-random-album-active "enabled" "disabled"))) +;;;###autoload (defun jao-random-album-next () (interactive) (with-current-buffer (get-buffer (funcall jao-random-album-buffer)) @@ -80,11 +82,12 @@ (when jao-random-album-notify (funcall jao-random-album-notify album))))) +;;;###autoload (defun jao-random-album-reset () (interactive) - (setq jao-random-lines nil) - (jao-random-lines-save)) + (jao-random-lines-save nil)) +;;;###autoload (defun jao-random-album-setup (album-buffer add-and-play stop) (setq jao-random-album-buffer album-buffer jao-random-album-add-tracks-and-play add-and-play diff --git a/lib/media/jao-spt.el b/lib/media/jao-spt.el deleted file mode 100644 index ba5d104..0000000 --- a/lib/media/jao-spt.el +++ /dev/null @@ -1,148 +0,0 @@ -;;; jao-spt.el --- Access to the spotify-tui CLI -*- lexical-binding: t; -*- - -;; Copyright (C) 2021, 2022, 2024 jao - -;; Author: jao <mail@jao.io> -;; Keywords: multimedia - -;; 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: - -;; Simple spotifyd controls via the spt executable. - -;;; Code: - -(require 'jao-minibuffer) -(require 'jao-notify) - -(defvar jao-spt-bin "spt") -(defvar jao-spt-format "'%s %t - %a [%r] %f'") -(defvar jao-spt-device nil) - -(defun jao-spt--exec-async (&rest args) - (let ((display-buffer-alist `((".*spt commands.*" display-buffer-no-window))) - (buff (get-buffer-create "* spt commands *"))) - (apply #'start-process "spt" buff jao-spt-bin args))) - -(defvar jao-spt--status-str "") - -(defun jao-spt--pb (&rest args) - (let* ((args (mapconcat #'identity args " ")) - (dev (if jao-spt-device (format "-d '%s'" jao-spt-device) "")) - (cmd (format "%s pb %s -f %s %s" jao-spt-bin args jao-spt-format dev)) - (st (string-trim (shell-command-to-string cmd)))) - (setq jao-spt--status-str (when (string-prefix-p "â–¶" st) st)) - (jao-minibuffer-refresh) - st)) - -(defun jao-spt--pb* (&rest args) - (message "%s" (apply 'jao-spt--pb args))) - -;;;###autoload -(defun jao-spt-play-uri (uri) - (jao-spt--exec-async "play" "--uri" uri)) - -;;;###autoload -(defun jao-spt-update-status () - (interactive) - (jao-spt--pb)) - -;;;###autoload -(defun jao-spt-toggle () - (interactive) - (jao-spt--pb* "-t")) - -;;;###autoload -(defun jao-spt-next () - (interactive) - (jao-spt--pb* "-n")) - -;;;###autoload -(defun jao-spt-previous () - (interactive) - (jao-spt--pb* "-p")) - -;;;###autoload -(defun jao-spt-like () - (interactive) - (jao-spt--pb* "--like")) - -;;;###autoload -(defun jao-spt-dislike () - (interactive) - (jao-spt--pb* "--dislike")) - -;;;###autoload -(defun jao-spt-toggle-shuffle () - (interactive) - (jao-spt--pb* "--shuffle")) - -;;;###autoload -(defun jao-spt-seek (&optional secs) - (interactive "p") - (let ((secs (if (zerop (or secs 0)) 10 secs))) - (jao-spt--pb* "--seek" (format "%d" secs)))) - -;;;###autoload -(defun jao-spt-seek-back (&optional secs) - (interactive "p") - (jao-spt-seek (- secs))) - -(defun jao-spt--get-vol (delta) - (let* ((jao-spt-format "%v") - (v (string-to-number (jao-spt--pb)))) - (number-to-string (max 0 (+ delta v))))) - -;;;###autoload -(defun jao-spt-vol (&optional n) - (interactive "p") - (let ((n (or n 10))) - (jao-spt--pb* "--volume" (jao-spt--get-vol (if (zerop n) 10 n))))) - -;;;###autoload -(defun jao-spt-vol-down (&optional n) - (interactive "p") - (jao-spt-vol (- (or n 10)))) - -;;;###autoload -(defun jao-spt-echo-current () - (interactive) - (let ((jao-notify-use-messages t)) - (jao-notify (jao-spt-update-status)))) - -;;;###autoload -(defun jao-spt-toggle-shuffle () - (interactive) - (jao-spt--pb* "--shuffle")) - -;;;###autoload -(defun jao-spt-set-up () - (jao-minibuffer-add-msg-variable 'jao-spt--status-str)) - -(defun jao-spt-lyrics-info () - (let* ((jao-spt-format "%a~~~%t") - (s (jao-spt--pb)) - (at (split-string s "~~~"))) - (cons (car at) (cadr at)))) - -(declare jao-show-lyrics "jao-lyrics") - -;;;###autoload -(defun jao-spt-show-lyrics (force) - (interactive "P") - (jao-show-lyrics force #'jao-spt-lyrics-info)) - -(provide 'jao-spt) -;;; jao-spt.el ends here diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el index 3c60cf8..76da717 100644 --- a/lib/net/jao-eww-session.el +++ b/lib/net/jao-eww-session.el @@ -1,6 +1,6 @@ ;;; jao-eww-session.el --- Persistent eww sessions -*- lexical-binding: t; -*- -;; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009, 2012, 2021, 2022 Jose A Ortega Ruiz +;; Copyright (C) 2003-2004, 2006-2009, 2012, 2021-2022, 2025-2026 Jose A Ortega Ruiz ;; Author: Jose A Ortega Ruiz <jao@gnu.org> ;; Version: 0.4 @@ -21,70 +21,23 @@ ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Commentary: - -;; jao-eww-session provides persistent eww browsing sessions. When -;; quitting eww (or, if you request it, at any other time while using -;; it) you can save the current eww session (that is, the set of open -;; tabs and the URLs they're visiting). Upon restarting emacs, you'll -;; have the possibity of recovering the saved session (that is, of -;; re-opening the saved tabs and URLs). You also have at your disposal -;; a command to recover the saved session at any other time, via the -;; commands: -;; -;; jao-eww-session-load -- load the last stored session -;; jao-eww-session-save -- save the current session -;; -;; A customization group, jao-eww-session, is available. There you can -;; customize the following variables: - ;;; Code: ;;; Dependencies: (require 'eww) (require 'url) - -;;; Custom variables: - -(defgroup jao-eww-session nil - "eww - session saving in eww." - :group 'eww - :prefix "jao-eww-session-") - -(defcustom jao-eww-session-save-always nil - "If on, always save eww session without asking." - :type 'boolean) - -(defcustom jao-eww-session-load-always t - "If on, always load eww session without asking." - :type 'boolean) - -(defcustom jao-eww-session-show-titles t - "If on, show URL titles in the load prompt." - :type 'boolean) - -(defcustom jao-eww-session-duplicate-tabs 'never - "How to treat session URL already being visited. - -When loading a session with `jao-eww-session-load', if one of the URLs in -the session is already displayed in a eww tab, jao-eww-session can: -- `never' create a new tab (just reload it), or -- `always' duplicate the URL in a new tab, or -- `ask' the user what to do." - :type '(choice (const :value never) - (const :value always) - (const :value ask))) - -(defcustom jao-eww-session-file "~/.emacs.d/eww-session.eld" - "File to save the eww session data." - :type 'file) +(require 'multisession) ;;; Internals: ;;;; auxiliary functions -(defvar jao-eww-current-session '(jao-eww-session 0 nil)) +(define-multisession-variable jao-eww-session '(0)) + +(defun jao-eww-session--current (&optional s) + (when s (setf (multisession-value jao-eww-session) s)) + (multisession-value jao-eww-session)) (defun jao-eww-session-eww-buffers (&optional skip) (seq-filter (lambda (b) @@ -92,10 +45,6 @@ the session is already displayed in a eww tab, jao-eww-session can: (with-current-buffer b (derived-mode-p 'eww-mode)))) (buffer-list))) -(defun jao-eww-session-invisible-buffers () - (seq-filter (lambda (b) (null (get-buffer-window b))) - (jao-eww-session-eww-buffers (current-buffer)))) - (defun jao-eww--current-url () (when-let* ((url (eww-current-url))) (url-encode-url url))) @@ -113,120 +62,45 @@ the session is already displayed in a eww tab, jao-eww-session can: (push (cons url (jao-eww-buffer-title)) urls))))) (defun jao-eww-session-urls (&optional s) - (let ((s (or s jao-eww-current-session))) - (mapcar 'car (nth 2 s)))) + (mapcar 'car (cadr (or s (jao-eww-session--current))))) (defun jao-eww-session-offset (&optional s) - (let ((s (or s jao-eww-current-session))) - (nth 1 s))) + (car (or s (jao-eww-session--current)))) (defun jao-eww-session-titles (&optional s) - (let ((s (or s jao-eww-current-session))) - (mapcar 'cdr (nth 2 s)))) + (let ((s (or s (jao-eww-session--current)))) + (mapcar 'cdr (cadr s)))) -(defun jao-eww-session--update-current (&optional skip-current) - (save-current-buffer - (setq jao-eww-current-session - (cons 'jao-eww-session (jao-eww-session--current-urls skip-current))))) +(defun jao-eww-session--update () + (jao-eww-session--current (jao-eww-session--current-urls))) (defun jao-eww-session--find-dups (urls) (seq-filter (lambda (b) - (with-current-buffer b - (when-let* ((url (jao-eww--current-url))) - (when (member url urls) - (when (y-or-n-p "Already open session, abort? ") - (switch-to-buffer b) - (user-error "Aborted")) - (or (and (eq jao-eww-session-duplicate-tabs 'never)) - (not (y-or-n-p (format "'%s' (%s) is already open. Duplicate? " - (jao-eww-buffer-title) url)))))))) + (with-current-buffer b (member (jao-eww--current-url) urls))) (jao-eww-session-eww-buffers))) -(defun jao-eww-session-load-aux () - (let ((new-session (jao-eww-session-from-file - (expand-file-name jao-eww-session-file)))) - (when (and new-session - (or jao-eww-session-load-always - (y-or-n-p - (if jao-eww-session-show-titles - (format "Load last eww session %S? " - (jao-eww-session-titles new-session)) - "Load last eww session? ")))) - (setq jao-eww-current-session new-session)))) - -(defun jao-eww-session-from-file (fname) - (let ((fname (jao-eww-session--check--backup fname))) - (when (file-readable-p fname) - (with-temp-buffer - (insert-file-contents fname) - (goto-char (point-min)) - (let ((sexp (read (current-buffer)))) - (and (equal 'jao-eww-session (car sexp)) sexp)))))) - -(defun jao-eww-session-not-empty () (> (length (jao-eww-session-urls)) 0)) - -(defun jao-eww-session--to--file (filename &optional skip) - (require 'pp) - (when (jao-eww-session-not-empty) - (let ((inhibit-message t) - (session (jao-eww-session--update-current skip))) - (with-temp-buffer - (insert ";;;; File generated by jao-eww-session. DO NOT EDIT!\n") - (pp session (current-buffer)) - (insert "\n" ";;;; End of " - (file-name-nondirectory jao-eww-session-file) "\n") - (write-region (point-min) (point-max) (expand-file-name filename)))))) - -(defun jao-eww-session--backup-name (fname) - (concat (expand-file-name fname) ".bak")) - -(defun jao-eww-session--check--backup (fname) - (let ((bfname (jao-eww-session--backup-name fname))) - (if (and (file-newer-than-file-p bfname fname) - (y-or-n-p "A newer autosaved session exists. Use it? ")) - bfname - fname))) - -(defun jao-eww-session--save-backup (&optional skip) - (let ((f (jao-eww-session--backup-name jao-eww-session-file))) - (jao-eww-session--to--file f skip))) - -(defun jao-eww-session--save-backup-1 () - (when (derived-mode-p 'eww-mode) (jao-eww-session--save-backup t))) - ;;;; save session on checkpoints -(add-hook 'kill-emacs-query-functions #'jao-eww-session-save) -(add-hook 'kill-buffer-hook #'jao-eww-session--save-backup-1) -(add-hook 'eww-after-render-hook #'jao-eww-session--save-backup) -(advice-add 'eww-back-url :after #'jao-eww-session--save-backup) -(advice-add 'eww-forward-url :after #'jao-eww-session--save-backup) +(add-hook 'eww-after-render-hook #'jao-eww-session--update) +(advice-add 'eww-back-url :after #'jao-eww-session--update) +(advice-add 'eww-forward-url :after #'jao-eww-session--update) -;;;###autoload (defun jao-eww-buffer-title () (plist-get eww-data :title)) -;;;###autoload -(defun jao-eww-session-save () - "Save the current eww session." - (interactive) - (when (and (jao-eww-session-not-empty) - (or jao-eww-session-save-always (y-or-n-p "Save eww session? "))) - (jao-eww-session--to--file jao-eww-session-file)) - t) - -;;;###autoload (defun jao-eww-session-load () "Load last stored session into eww." (interactive) - (when-let* ((s (jao-eww-session-load-aux))) - (let* ((urls (jao-eww-session-urls s)) - (offset (jao-eww-session-offset s)) - (buffers (unless (equal jao-eww-session-duplicate-tabs 'always) - (jao-eww-session--find-dups urls)))) - (dolist (url urls) (eww url 4)) - (seq-each #'kill-buffer buffers) - (unless (zerop offset) - (switch-to-buffer (nth offset (jao-eww-session-eww-buffers))))))) + (let* ((urls (jao-eww-session-urls)) + (offset (jao-eww-session-offset)) + (dups (jao-eww-session--find-dups urls))) + (dolist (url urls) (eww url 4)) + (seq-each #'kill-buffer dups) + (unless (zerop offset) + (switch-to-buffer (nth offset (jao-eww-session-eww-buffers)))))) + +(defun jao-eww-session-invisible-buffers () + (seq-filter (lambda (b) (null (get-buffer-window b))) + (jao-eww-session-eww-buffers (current-buffer)))) (provide 'jao-eww-session) ;;; jao-eww-session.el ends here diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el index 1a03613..9b408c2 100644 --- a/lib/net/jao-notmuch-gnus.el +++ b/lib/net/jao-notmuch-gnus.el @@ -1,6 +1,6 @@ ;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- -;; Copyright (C) 2022, 2024 jao +;; Copyright (C) 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -52,7 +52,7 @@ "Interactively add or remove tags to the current message." (interactive) (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (unless tags (jao-notmuch-gnus-message-tags id))) + (current (or tags (jao-notmuch-gnus-message-tags id))) (prompt (format "Change tags %s" (string-join current "/"))) (tags (or tags (notmuch-read-tag-changes current prompt)))) (notmuch-tag (concat "id:" id) tags) @@ -65,6 +65,11 @@ (when-let* ((id (jao-notmuch-gnus-message-id))) (message "%s" (string-join (jao-notmuch-gnus-message-tags id) " ")))) +(jao-transient-major-mode+ gnus-summary + ["Tags" + ("s" "show message tags" jao-notmuch-gnus-show-tags) + ("t" "tag message" jao-notmuch-gnus-tag-message)]) + (defun jao-notmuch-gnus-toggle-tags (tags &optional id current) "Toggle the given TAGS list for the current Gnus message." (let* ((id (or id (jao-notmuch-gnus-message-id))) @@ -76,9 +81,9 @@ (message "New tags: %s" (jao-notmuch-gnus-message-tags id)))) (defun jao-notmuch-gnus-tag-mark () - "Remove the new tag for an article when it's marked as seen by Gnus." + "Remove the new and unread tags for an article when it's marked as seen by Gnus." (when-let* ((id (jao-notmuch-gnus-message-id t))) - (jao-notmuch-gnus-tag-message id '("-new") t))) + (jao-notmuch-gnus-tag-message id '("-new" "-unread") t))) (add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark) @@ -105,8 +110,32 @@ (add-to-list 'gnus-search-expandable-keys "list") -(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) +(defclass gnus-search-jao-notmuch (gnus-search-notmuch) ()) + +(cl-defmethod gnus-search-indexed-search-command + ((engine gnus-search-jao-notmuch) (qstring string) query &optional groups) + (let* ((limit (alist-get 'limit query)) + (thread (alist-get 'thread query)) + (qs (cond (thread + (format "thread:\"{%s}\"" + (thread-last (string-replace "\"" "\"\"" qstring) + (string-replace "<" "") + (string-replace ">" "")))) + (groups + (let ((gs (mapconcat 'gnus-group-short-name groups "|"))) + (format "(%s) and folder:/%s/" qstring gs))) + (t qstring)))) + (with-slots (switches config-file) engine + `(,(format "--config=%s" config-file) "search" "--output=files" + ,@(unless thread '("--duplicate=1")) + ,@(when limit (list (format "--limit=%d" limit))) + ,@switches + ,qs)))) + + +(cl-defmethod gnus-search-transform-expression ((engine gnus-search-jao-notmuch) (expr (head list))) + (message "List query: %s" expr) (format "List:%s" (gnus-search-transform-expression engine (cdr expr)))) @@ -171,7 +200,7 @@ Example: (msg-id (when msg-id (replace-regexp-in-string "^id:" "" msg-id)))) (if (and group msg-id) (org-gnus-follow-link group msg-id) - (message "Couldn't get relevant infos for switching to Gnus.")))) + (message "Couldn't get relevant info for switching to Gnus.")))) (defun jao-notmuch-gnus-engine (prefix config) (let ((prefix (file-name-as-directory (expand-file-name prefix "~"))) @@ -208,20 +237,18 @@ Example: (org-link-set-parameters "gnus" :store #'ignore) (org-link-set-parameters "notmuch" :store #'ignore) -;;; consult-notmuch +;;; tags and flags -(with-eval-after-load "consult-notmuch" - (defun jao-notmuch-gnus--open-candidate (candidate) - "Open a notmuch-search completion candidate email in Gnus." - (message "candidate: %S" candidate) - (jao-notmuch-gnus-goto-message (consult-notmuch--candidate-id candidate))) +(defun jao-notmuch-gnus-flag-current (&rest _) + (jao-notmuch-gnus-tag-message nil '("+flagged") t)) - (defun jao-gnus-consult-notmuch () - "Run a consult-notmuch query that opens candidates in Gnus." - (interactive) - (jao-notmuch-gnus--open-candidate (consult-notmuch--search))) +(defun jao-notmuch-gnus-unflag-current (&rest _) + (jao-notmuch-gnus-tag-message nil '("-flagged") t)) - (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) +(advice-add 'gnus-summary-tick-article-forward + :before #'jao-notmuch-gnus-flag-current) +(advice-add 'gnus-summary-mark-as-read-forward + :before #'jao-notmuch-gnus-unflag-current) ;;; . (provide 'jao-notmuch-gnus) diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el index 2dc4b70..db23bc1 100644 --- a/lib/net/jao-notmuch.el +++ b/lib/net/jao-notmuch.el @@ -1,6 +1,6 @@ -;;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*- +;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022, 2023, 2024 jao +;; Copyright (C) 2021, 2022, 2023, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -25,16 +25,152 @@ (require 'outline) (require 'mm-decode) (require 'mm-view) +(require 'shr) +(require 'ol) +(require 'browse-url) (require 'notmuch) (require 'notmuch-tree) (require 'notmuch-show) +;;; searches +(defvar jao-notmuch--new nil) +(defvar jao-notmuch--new-rx nil) +(defvar jao-notmuch--newa nil) + +(defvar jao-notmuch-widened-searches nil) + +(defun jao-notmuch--tags-q (tags) + (format "tag:\"/^(%s)$/\"" (mapconcat (lambda (s) (format "%s" s)) tags "|"))) + +(defun jao-notmuch--new (&rest tags) + (cond ((listp jao-notmuch--new) + (jao-notmuch--tags-q (append jao-notmuch--new tags))) + (tags (concat jao-notmuch--new " OR " (jao-notmuch--tags-q tags))) + (t jao-notmuch--new))) + +(defun jao-notmuch--set-new-search (s) + (setq jao-notmuch--new s + jao-notmuch--new-rx (regexp-quote (jao-notmuch--new)) + jao-notmuch--newa (concat (jao-notmuch--new) " AND "))) + +(defun jao-notmuch--q (d0 &optional k d1 qs st) + (let* ((qs (when qs (mapconcat (lambda (q) (format "%s" q)) qs " AND "))) + (q (or qs + (concat (jao-notmuch--new) + (mapconcat (lambda (d) (when d (concat " AND tag:" d))) + (list d0 d1)))))) + (list :name (concat d0 (when (and d1 (not (string= "" d1))) "/") d1) + :key k :query q :search-type (or st 'tree) + :sort-order 'oldest-first))) + +(defun jao-notmuch--q-feed (q) + (apply #'jao-notmuch--q (cons "feeds" q))) + +;;;###autoload +(defun jao-notmuch-init-searches (s &optional other) + (jao-notmuch--set-new-search s) + + (setq notmuch-hello-sections nil + notmuch-saved-searches nil + jao-notmuch-widened-searches nil) + + (when other (jao-notmuch-def-searches (car other) (cdr other)))) + +;;;###autoload +(defun jao-notmuch-tree-widen-search () + (interactive) + (when-let* ((query (notmuch-tree-get-query))) + (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))) + (notmuch-tree-close-message-window) + (notmuch-tree (string-replace jao-notmuch--newa "" query))))) + +(defun jao-notmuch--widen (s &optional extra) + (let* ((q (plist-get s :query)) + (qs (string-replace jao-notmuch--newa "" q))) + (plist-put (copy-sequence s) :query (concat qs extra)))) + +;;;###autoload +(defun jao-notmuch-widen-searches (searches &optional extra) + (mapcar (lambda (s) (jao-notmuch--widen s extra)) searches)) + +(defun jao-notmuch-hello--insert-searches (searches title title-face) + (when-let* ((searches (notmuch-hello-query-counts searches))) + (let* ((cnt (when title + (seq-reduce (lambda (c q) + (+ c (or (plist-get q :count) 0))) + searches + 0))) + (title (when title (format "%d %s" cnt title))) + (notmuch-column-control 1.0) + (title-face (or title-face 'jao-themes-f00))) + (when title + (widget-insert (propertize title 'face title-face)) + (newline) + (jao-notmuch-hbar 5)) + (notmuch-hello-insert-buttons searches) + (newline)))) + +(defun jao-notmuch--replace (lst s) + (let ((name (plist-get s :name))) + (set lst (seq-remove (lambda (s0) (string= name (plist-get s0 :name))) + (symbol-value lst))) + (add-to-list lst s t))) + +;;;###autoload +(defun jao-notmuch-def-searches (name searches &optional no-save title-face) + (declare (indent 1)) + (unless no-save + (dolist (s searches) + (jao-notmuch--replace 'jao-notmuch-widened-searches + (jao-notmuch--widen s)) + (jao-notmuch--replace 'notmuch-saved-searches s))) + (add-to-list 'notmuch-hello-sections + `(jao-notmuch-hello--insert-searches ,searches ,name ,title-face) + t)) + +;;; jump to searches +(defun jao-notmuch--searches-w/new (searches) + (seq-filter (lambda (s) + (string-match-p jao-notmuch--new-rx (plist-get s :query))) + (notmuch-hello-query-counts searches))) + +(defconst jao-notmuch--search-keys '("a" "s" "d" "f" "g" "h" "j" "k" "l")) + +(defun jao-notmuch--index-searches (searches) + (seq-map-indexed (lambda (q i) + (plist-put q :key (or (elt jao-notmuch--search-keys i) + (format "%s" i)))) + searches)) + +;;;###autoload +(defun jao-notmuch-jump-search (&optional widen) + (interactive "P") + (let ((notmuch-saved-searches + (if widen jao-notmuch-widened-searches notmuch-saved-searches))) + (notmuch-jump-search))) + +;;;###autoload +(defun jao-notmuch-jump () + "Jump to a saved, non-zero count search." + (interactive) + (if-let* ((searches (jao-notmuch--searches-w/new notmuch-saved-searches))) + (if (= 2 (length searches)) + (let* ((q (seq-remove (lambda (q) (string= "new" (plist-get q :name))) + searches)) + (q (car q)) + (of (eq 'oldest-first (plist-get q :sort-order))) + (query (plist-get q :query))) + (notmuch-tree query nil nil nil nil nil nil of t)) + (let ((notmuch-saved-searches (jao-notmuch--index-searches searches))) + (notmuch-jump-search))) + (jao-notmuch-jump-search t))) + ;;; targetting the displayed message from the tree view (defvar-local jao-notmuch--tree-buffer nil) -(declare eww--url-at-point "eww") +(declare-function eww--url-at-point "eww") (defun jao-notmuch-goto-message-buffer (&optional and-click no-record) (interactive "P") @@ -167,7 +303,7 @@ (jao-notmuch-goto-tree-buffer t))) (defun jao-notmuch--view-html () - "Open the text/html part of the current message using `notmuch-show-view-part'." + "Open the text/html part of current message using `notmuch-show-view-part'." (interactive) (save-excursion (goto-char @@ -183,10 +319,11 @@ (defvar-local jao-notmuch--showing-images nil) (defun jao-notmuch--shr-toggle-images () + (require 'eww) (let* ((b notmuch-tree-message-buffer) (show (not (buffer-local-value 'jao-notmuch--showing-images b))) (mm-text-html-renderer 'shr) - (shr-blocked-images (unless show shr-blocked-images)) + ;; (shr-blocked-images (unless show shr-blocked-images)) (shr-inhibit-images (not show)) (notmuch-show-text/html-blocked-images (unless show notmuch-show-text/html-blocked-images)) @@ -212,7 +349,7 @@ (with-current-buffer notmuch-tree-message-buffer (jao-notmuch--view-html)))))) -;;; header line with thread message counts +;;; header and mode lines with thread message counts (defun jao-notmuch--looking-at-new-p (&optional p) (when-let* ((ts (if p (plist-get p :tags) (notmuch-show-get-tags)))) @@ -265,8 +402,10 @@ (tb (seq-find (lambda (b) (with-current-buffer b (and (derived-mode-p 'notmuch-tree-mode) b))) - (buffer-list)))) - `((:eval (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject))) + (buffer-list))) + (subject (propertize subject 'face 'message-header-subject))) + `((:eval + (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject))) (concat " " subject))) (defun jao-notmuch--format-lighter () @@ -316,6 +455,12 @@ (let ((undo (jao-notmuch--has-tag "deleted"))) (jao-notmuch-tree-tag-thread '("+deleted" "-new" "-unread") undo full))) +(defun jao-notmuch-tree-mark-all-read () + (interactive) + (when-let* ((q notmuch-tree-basic-query)) + (when (yes-or-no-p "Mark all messages as read? ") + (notmuch-tag q '("-new" "-unread"))))) + (defun jao-notmuch-tree-read-thread (full) (interactive "P") (jao-notmuch-tree-tag-thread '("-unread" "-new") nil full)) @@ -339,35 +484,31 @@ (let ((tags (plist-get (notmuch-tree-get-message-properties) :orig-tags))) (jao-notmuch-tree--tag tags nil))) +(defvar jao-notmuch--shared-tags + '("new" "unread" "flagged" "signed" "sent" "attachment" "forwarded" "inbox" + "encrypted" "gmane" "gnus" "feeds" "rss" "mce" "trove" "prog" "emacs")) + +(defun jao-notmuch-subtags (tag &rest excl) + (let* ((cmd (concat "notmuch search --output=tags tag:" tag)) + (ts (split-string (shell-command-to-string cmd)))) + (seq-difference ts (append jao-notmuch--shared-tags (cons tag excl))))) + ;;; fcc -(defvar jao-notmuch-mua-reply-not-inherited - '("attachment" "sent" "new" "bigml" "jao" "trove")) - -(defun jao-notmuch-mua--fcc-dirs () - (let* ((otags (notmuch-show-get-tags)) - (trove (or (seq-some (lambda (x) (and (member x otags) x)) - '("hacking" "bills" "feeds" "jao")) - "jao")) - (tags (seq-difference otags jao-notmuch-mua-reply-not-inherited)) - (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) - (fcc (concat "trove/" trove " " tagstr " -new +sent +trove")) - (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) - (append fcc-dirs `((".*" . ,fcc))))) +(defvar jao-notmuch-tags-not-inherited + '("attachment" "sent" "new" "trove" "flagged" "drivel" "replied")) + +(defvar jao-notmuch-sent-dir "sent") (defun jao-notmuch-mua--inherited-fcc () - (let* ((fn (notmuch-show-get-filename)) - (dest (and (string-match ".*/var/mail/\\(.+?\\)/.+" fn) - (match-string 1 fn))) - (tags (seq-difference (notmuch-show-get-tags) - '("attachment" "sent" "new" "flagged"))) + (let* ((tags (seq-difference (notmuch-show-get-tags) + jao-notmuch-tags-not-inherited)) (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) - (fcc (concat dest " " tagstr " -new +sent +trove")) + (fcc (concat jao-notmuch-sent-dir " " tagstr " -new +sent")) (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) (append fcc-dirs `((".*" . ,fcc))))) (defun jao-notmuch-mua-new-reply (fun &rest args) - (let ((notmuch-fcc-dirs (and (not (notmuch-show-get-header :List-Id)) - (jao-notmuch-mua--inherited-fcc)))) + (let ((notmuch-fcc-dirs (jao-notmuch-mua--inherited-fcc))) (apply fun args))) (advice-add 'notmuch-mua-new-reply :around #'jao-notmuch-mua-new-reply) @@ -378,15 +519,22 @@ (or (> (length a) (length b)) (string-lessp a b))) (defun jao-notmuch-format-tags (fmt msg) - (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg) - (split-string) - ;; (seq-sort-by #'length #'<) - (seq-sort #'jao-notmuch-cmp-tags)))) - (format-spec fmt `((?s . ,(mapconcat #'identity ts " ")))))) - -(defun jao-notmuch-format-tree-and-subject (fmt msg) + (if (> (window-width) 85) + (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg) + (split-string) + ;; (seq-sort-by #'length #'<) + (seq-sort #'jao-notmuch-cmp-tags)))) + (format-spec fmt `((?s . ,(mapconcat #'identity ts " "))))) + "")) + +(defun jao-notmuch-format-authors (threshold msg) + (let ((fmt (if (< (window-width) threshold) "%-15s" "%-35s"))) + (notmuch-tree-format-field "authors" fmt msg))) + +(defun jao-notmuch-format-tree-and-subject (_fmt msg) (let ((tr (notmuch-tree-format-field "tree" " %s" msg)) - (sb (notmuch-tree-format-field "subject" " %s" msg))) + (sb (notmuch-tree-format-field "subject" " %s" msg)) + (fmt (format "%%>-%ds" (- (window-width) 45)))) (format-spec fmt `((?s . ,(concat tr sb)))))) (defun jao-notmuch-format-msg-ticks (mails-rx msg) @@ -398,4 +546,33 @@ (t " ")))) (provide 'jao-notmuch) + +;;; bars +(defvar jao-notmuch-bar-max 188) + +(defun jao-notmuch-hbar (margin) + (let ((w (- (min (window-width) jao-notmuch-bar-max) margin))) + (widget-insert (propertize (make-string w ?—) 'face '(:foreground "grey80")))) + (newline)) + +;;; org links +(defun jao-notmuch-id-file-name (id) + (let ((cmd (format "notmuch search --output=files id:%s" id))) + (car (split-string (shell-command-to-string cmd))))) + +(defun jao-notmuch-org-store () + (when-let* ((d (and (derived-mode-p '(notmuch-show-mode notmuch-tree-mode)) + (cons (notmuch-show-get-message-id) + (notmuch-show-get-subject))))) + (org-link-store-props :type "mail" + :link (concat "mail:" (car d)) + :description (concat "Mail: " (cdr d))))) + +(defun jao-notmuch-org-links () + (org-link-set-parameters "mail" + :follow #'notmuch-show + :store #'jao-notmuch-org-store) + (org-link-set-parameters "gnus" :store #'ignore) + (org-link-set-parameters "notmuch" :store #'ignore)) + ;;; jao-notmuch.el ends here diff --git a/lib/net/jao-proton-utils.el b/lib/net/jao-proton-utils.el deleted file mode 100644 index 0c9ccd7..0000000 --- a/lib/net/jao-proton-utils.el +++ /dev/null @@ -1,141 +0,0 @@ -;; jao-proton-utils.el -- simple interaction with Proton mail and vpn - -;; Copyright (c) 2018, 2019, 2020, 2023 Jose Antonio Ortega Ruiz - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> -;; Start date: Fri Dec 21, 2018 23:56 - -;;; Comentary: - -;; This is a very simple comint-derived mode to run the CLI version -;; of PM's Bridge within the comfort of emacs. - -;;; Code: - -(define-derived-mode proton-bridge-mode comint-mode "proton-bridge" - "A very simple comint-based mode to run ProtonMail's bridge" - (setq comint-prompt-read-only t) - (setq comint-prompt-regexp "^>>> ")) - -;;;###autoload -(defun run-proton-bridge () - "Run or switch to an existing bridge process, using its CLI" - (interactive) - (pop-to-buffer (make-comint "proton-bridge" "protonmail-bridge" nil "-c")) - (unless (eq major-mode 'proton-bridge-mode) - (proton-bridge-mode))) - -;;;###autoload -(defun proton-bridge-sendmail-setup () - "Configure message sending for local proton bridge." - (setq send-mail-function #'smtpmail-send-it) - (setq message-send-mail-function #'smtpmail-send-it) - (setq smtpmail-servers-requiring-authorization - (regexp-opt '("localhost" "127.0.0.1"))) - (setq smtpmail-auth-supported '(plain login)) - (setq smtpmail-smtp-user "mail@jao.io") - (setq smtpmail-smtp-server "localhost") - (setq smtpmail-smtp-service 1025)) - -(defvar jao-proton-vpn-font-lock-keywords '("\\[.+\\]")) - -;;;###autoload -(defun proton-vpn-mode () - "A very simple mode to show the output of ProtonVPN commands" - (interactive) - (kill-all-local-variables) - (buffer-disable-undo) - (use-local-map proton-vpn-mode-map) - (setq-local font-lock-defaults '(jao-proton-vpn-font-lock-keywords)) - (setq-local truncate-lines t) - (setq-local next-line-add-newlines nil) - (setq major-mode 'proton-vpn-mode) - (setq mode-name "proton-vpn") - (read-only-mode 1)) - -(defvar jao-proton-vpn--buffer "*pvpn*") - -(defun jao-proton-vpn--do (things) - (let ((b (pop-to-buffer (get-buffer-create jao-proton-vpn--buffer)))) - (let ((inhibit-read-only t) - (cmd (format "protonvpn-cli %s" things))) - (delete-region (point-min) (point-max)) - (message "Running: %s ...." cmd) - (shell-command cmd b) - (message "")) - (proton-vpn-mode))) - -;;;###autoload -(defun proton-vpn-status () - (interactive) - (jao-proton-vpn--do "s")) - -(defun proton-vpn--get-status () - (or (when-let* ((b (get-buffer jao-proton-vpn--buffer))) - (with-current-buffer b - (goto-char (point-min)) - (if (re-search-forward "^Status: *\\(.+\\)$" nil t) - (match-string-no-properties 1) - (when (re-search-forward "^Connected!$") - "Connected")))) - "Disconnected")) - -;;;###autoload -(defun proton-vpn-connect (cc) - (interactive "P") - (let ((cc (when cc (read-string "Country code: ")))) - (jao-proton-vpn--do (if cc (format "c --cc %s" cc) "c --sc")) - (proton-vpn-status))) - -(defun proton-vpn-reconnect () - (interactive) - (jao-proton-vpn--do "r")) - -(setenv "PVPN_WAIT" "300") - -;;;###autoload -(defun proton-vpn-maybe-reconnect () - (interactive) - (when (string= "Connected" (proton-vpn--get-status)) - (jao-proton-vpn--do "d") - (sit-for 5) - (jao-proton-vpn--do "r"))) - -;;;###autoload -(defun proton-vpn-disconnect () - (interactive) - (jao-proton-vpn--do "d")) - -(setq proton-vpn-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (define-key map [?q] 'bury-buffer) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?g] 'proton-vpn-status) - (define-key map [?r] 'proton-vpn-reconnect) - (define-key map [?d] (lambda () - (interactive) - (when (y-or-n-p "Disconnect?") - (proton-vpn-disconnect)))) - (define-key map [?c] 'proton-vpn-connect) - map)) - - -(provide 'jao-proton-utils) -;;; jao-proton.el ends here diff --git a/lib/net/jao-r2e.el b/lib/net/jao-r2e.el new file mode 100644 index 0000000..76fed8f --- /dev/null +++ b/lib/net/jao-r2e.el @@ -0,0 +1,249 @@ +;;; jao-r2e.el --- List of rss2email subscriptions -*- lexical-binding: t; -*- + +;; Copyright (C) 2025, 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: news + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(require 'multisession) +(require 'jao-url) + +(autoload 'View-quit "view") +(autoload 'eww-view-source "eww") +(autoload 'jao-notmuch-subtags "jao-notmuch") + +(defvar jao-r2e-command "r2e") +(defvar jao-r2e-confirm-toggle nil) + +(defconst jao-r2e--buffer "*r2e*") +(defun jao-r2e--buffer () + (with-current-buffer (get-buffer-create jao-r2e--buffer) + (unless (derived-mode-p 'jao-r2e-mode) + (jao-r2e-mode)) + (current-buffer))) + +(defvar jao-r2e-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [?q] 'bury-buffer) + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?N] 'jao-r2e-next) + (define-key map [?P] 'jao-r2e-prev) + (define-key map [?g] 'jao-r2e-list) + (define-key map [?s] 'jao-r2e-subscribe) + (define-key map [?t] 'jao-r2e-toggle) + (define-key map [?D] 'jao-r2e-delete) + (define-key map [?u] 'jao-r2e-recover) + (define-key map [?y] 'jao-r2e-kill-url) + (define-key map [?x] 'jao-r2e-list-subscribed) + map)) + +;;;###autoload +(defun jao-r2e-mode () + "A very simple mode to show the output of r2e commands." + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map jao-r2e-mode-map) + ;; (setq-local font-lock-defaults '(jao-r2e-font-lock-keywords)) + (setq-local truncate-lines t) + (setq-local next-line-add-newlines nil) + (setq major-mode 'jao-r2e-mode) + (setq mode-name "r2e") + (read-only-mode 1)) + +(defun jao-r2e--do (things &optional buffer) + "Execute a r2e command THINGS in the given BUFFER." + (let ((b (or buffer (pop-to-buffer (jao-r2e--buffer))))) + (let ((inhibit-read-only t) + (cmd (format "%s %s" jao-r2e-command things))) + (unless buffer + (with-current-buffer b (delete-region (point-min) (point-max)))) + (with-temp-message (format "Running: %s ...." cmd) + (shell-command cmd b)) + (unless buffer (read-only-mode 1))))) + +(defconst jao-r2e--feed-rx + "^\\([0-9]+\\): \\[\\( \\|\\*\\)\\] \\([^ ]+\\) (\\(.+\\) -> \\(.+\\))") + +(defun jao-r2e--feed-at-point () + (beginning-of-line) + (when-let* ((m (looking-at jao-r2e--feed-rx))) + (list (match-string 1) + (match-string 3) + (string= "*" (match-string 2)) + (match-string 4) + (match-string 5)))) + +(defun jao-r2e () + (interactive) + (pop-to-buffer (jao-r2e--buffer)) + (when (looking-at-p "^$") + (jao-r2e-list))) + +(defun jao-r2e-list () + (interactive) + (jao-r2e--do "list")) + +(defun jao-r2e-list-subscribed (arg) + "Show only subscribed (unsubscribed with arg) feeds." + (interactive "P") + (jao-r2e-list) + (let ((inhibit-read-only t)) + (flush-lines (if arg ".*\\[\\*\\].*" ".*\\[ \\].*")))) + +(defun jao-r2e--srx (opp) + (when-let* ((f (jao-r2e--feed-at-point))) + (let ((a (if opp (not (caddr f)) (caddr f)))) + (format "^[0-9]+: \\[%s\\] " (if a "\\*" " "))))) + +(defun jao-r2e-next (opp) + "Next feed with the same (or opposite) status." + (interactive "P") + (when-let* ((rx (jao-r2e--srx opp))) + (forward-line) + (when (re-search-forward rx nil t) + (beginning-of-line)))) + +(defun jao-r2e-prev (opp) + "Previous feed with the same (or opposite) status." + (interactive "P") + (when-let* ((rx (jao-r2e--srx opp))) + (when (re-search-backward rx nil t) + (beginning-of-line)))) + +(defun jao-r2e-kill-url () + "Copy as kill the URL of the feed at point." + (interactive) + (let ((url (cadddr (jao-r2e--feed-at-point)))) + (if (not url) + (error "No feed at point") + (kill-new url) + (message "%s" url)))) + +(defun jao-r2e-toggle () + (interactive) + (let ((f (jao-r2e--feed-at-point))) + (unless f (error "No feed at point")) + (let ((p (point)) + (no (car f)) + (name (cadr f)) + (act (if (caddr f) "pause" "unpause"))) + (when (or (not jao-r2e-confirm-toggle) + (yes-or-no-p (format "%s '%s'? " act name))) + (with-temp-buffer + (jao-r2e--do (format "%s %s" act no) (current-buffer))) + (jao-r2e-list) + (goto-char p))))) + +(define-multisession-variable jao-r2e-deleted-feeds '() + "List of rss2email feeds deleted at some point.") + +(defun jao-r2e--deleted () (multisession-value jao-r2e-deleted-feeds)) + +(defun jao-r2e-delete () + "Delete feed at point. Use `jao-r2e-recover' to undelete." + (interactive) + (let ((f (jao-r2e--feed-at-point))) + (unless f (error "No feed at point")) + (let ((p (point)) + (no (car f)) + (entry (cdr f))) + (when (yes-or-no-p (format "Delete feed '%s'" (car entry))) + (setf (multisession-value jao-r2e-deleted-feeds) + (cons entry (remove entry (jao-r2e--deleted)))) + (with-temp-buffer + (jao-r2e--do (format "delete %s" no) (current-buffer))) + (jao-r2e-list) + (goto-char p))))) + +;;;###autoload +(defun jao-r2e-edit-deleted () + (interactive) + (let ((kept nil)) + (dolist (feed (jao-r2e--deleted)) + (when (y-or-n-p (format "Keep %s? " feed)) + (push feed kept))) + (setf (multisession-value jao-r2e-deleted-feeds) kept) + (message "%s feeds kept" (length kept)))) + +(defun jao-r2e-recover () + (interactive) + (when (seq-empty-p (jao-r2e--deleted)) + (error "No feeds recoverable at this point.")) + (let* ((entries (jao-r2e--deleted)) + (feed (completing-read "Recover feed: " entries))) + (when-let* ((ps (assoc feed entries)) + (url (caddr ps)) + (mail (car (last ps))) + (cat (when (string-match "feeds\\.\\(.+\\)@localhost" mail) + (match-string 1 mail)))) + (jao-r2e-subscribe (list url feed) cat t) + (setf (multisession-value jao-r2e-deleted-feeds) (remove ps entries))))) + +(defun jao-r2e--find-url () + (save-excursion + (when (derived-mode-p 'w3m-mode 'eww-mode) + (if (fboundp 'w3m-view-source) (w3m-view-source) (eww-view-source))) + (goto-char (point-min)) + (when (re-search-forward + "type=\"application/\\(?:atom\\|rss\\)\\+xml\" +" nil t) + (let ((url (save-excursion + (when (re-search-forward + "href=\"\\([^\n\"]+\\)\"" nil t) + (match-string-no-properties 1)))) + (title (when (re-search-forward + "\\(?:title=\"\\([^\n\"]+\\)\" +\\)" nil t) + (match-string-no-properties 1)))) + (when (string-match-p ".*\\*eww-source\\b.*" (buffer-name)) + (View-quit)) + (when url (cons url (or title ""))))))) + +(defun jao-r2e-remove-shorts (url) + (if (and (string-match-p "www\.youtube\.com" url) + (y-or-n-p "Remove shorts? ")) + (string-replace "channel_id=UC" "playlist_id=UULF" url) + url)) + +;;;###autoload +(defun jao-r2e-subscribe (url &optional cat relist) + "Subscribe to a given RSS URL. If URL not given, look for it." + (interactive (list (or (jao-url-around-point) + (jao-r2e--find-url) + (read-string "Feed URL: ")))) + (let* ((url+title (ensure-list url)) + (url (car url+title)) + (title (cdr url+title))) + (unless url (error "No feeds found")) + (let ((url (if (string-match "^feed:" url) (substring url 5) url))) + (when (y-or-n-p (format "Subscribe to <%s>? " url)) + (let* ((url (jao-r2e-remove-shorts url)) + (name (read-string "Feed name: " title)) + (cats (cons "prog" (jao-notmuch-subtags "feeds"))) + (cat (completing-read "Category: " cats nil t cat)) + (sfmt (format "%%s add %s '%s' mail+feeds_%s@jao.io" name url cat))) + (with-temp-message "Subscribing..." + (shell-command-to-string (format sfmt "r2e")) + (when (not (string= jao-r2e-command "r2e")) + (shell-command-to-string (format sfmt jao-r2e-command)))) + (when (y-or-n-p "Retrieve feeds now? ") + (with-temp-message "Retrieving feed..." + (shell-command (format "%s run %s" jao-r2e-command name)))) + (when relist (jao-r2e-list))))))) + +(provide 'jao-r2e) +;;; jao-r2e.el ends here diff --git a/lib/net/jao-url.el b/lib/net/jao-url.el new file mode 100644 index 0000000..ac66cef --- /dev/null +++ b/lib/net/jao-url.el @@ -0,0 +1,45 @@ +;;; jao-url.el --- URL handling -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: hypermedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(require 'shr) +(require 'ffap) +(require 'thingatpt) + +(defun jao-url-around-point (&optional current-url) + (or (and (fboundp 'w3m-anchor) (w3m-anchor)) + (shr-url-at-point nil) + (ffap-url-at-point) + (thing-at-point 'url) + (when current-url + (or (and (fboundp 'w3m-anchor) (w3m-anchor)) + (and (derived-mode-p 'eww-mode) (plist-get eww-data :url)))))) + + +(defun jao-url-email-url () + (save-excursion + (goto-char (point-min)) + (when (or (search-forward-regexp "^Via: h" nil t) + (search-forward-regexp "^URL:[\n ]h" nil t) + (and (search-forward-regexp "^Link$" nil t) + (not (beginning-of-line)))) + (jao-url-around-point)))) + +(provide 'jao-url) +;;; jao-url.el ends here diff --git a/lib/net/randomsig.el b/lib/net/randomsig.el index cb37694..e3c735b 100644 --- a/lib/net/randomsig.el +++ b/lib/net/randomsig.el @@ -1,6 +1,6 @@ -;;; randomsig.el --- insert a randomly selected signature +;;; randomsig.el --- insert a randomly selected signature -*- lexical-binding: t; -*- -;; Copyright (C) 2001, 2002, 2013, 2020, 2021 Hans-Jürgen Ficker +;; Copyright (C) 2001, 2002, 2013, 2020, 2021, 2024, 2026 Hans-Jürgen Ficker ;; Emacs Lisp Archive Entry ;; Author: Hans-Juergen Ficker <hj@backmes.de> @@ -277,8 +277,11 @@ You probably want to have a newline at the end of it." (defun randomsig-prompt (&optional prompt) ;; Prompt for a signature file. (let ((files (randomsig-files-to-list randomsig-files))) - (completing-read (if prompt prompt "signature: ") - (mapcar 'list files) nil t nil randomsig-history (car files)))) + (if (cdr files) + (completing-read (if prompt prompt "signature: ") + (mapcar 'list files) nil t nil + randomsig-history (car files)) + (car files)))) (defun randomsig-read-signatures-to-buffer (buffer-name &optional files) ;; read the signatures into the signature buffer @@ -305,7 +308,7 @@ You probably want to have a newline at the end of it." ;; get a list with file names of signature files (let ((sigfiles (randomsig-files-to-list files))) ;; Insert all files into the newly created buffer - (mapcar + (mapc (lambda (fname) (let ((pos (point-max))) @@ -345,10 +348,10 @@ You probably want to have a newline at the end of it." (defun randomsig-goto-signature () -;; This function is stolen fom message-goto signature. -;; Go to beginnig of the signature, and return t. -;; If there is no signature in current buffer, go to end of buffer, -;; and return nil. + ;; This function is stolen fom message-goto signature. + ;; Go to beginnig of the signature, and return t. + ;; If there is no signature in current buffer, go to end of buffer, + ;; and return nil. (goto-char (point-min)) (if (re-search-forward "^-- $" nil t) (progn @@ -380,30 +383,25 @@ Else a signature out of `randomsig-files' will be choosen." (randomsig-read-signatures-to-buffer randomsig-buffer-name files) (goto-char (point-min)) - (let '(count 0) 'selected - - ;; Count number of signatures - (while (search-forward-regexp randomsig-delimiter-pattern nil t) - (setq count (1+ count))) - - ;; Select random signature out out these - (setq selected (1+ (random count))) - (goto-char (point-min)) - (if (search-forward-regexp randomsig-delimiter-pattern nil t selected) - (forward-char)) - - ;; Cut signature and return it - (let '(here (point)) 'signature-string - - (if (not (search-forward-regexp randomsig-delimiter-pattern - nil t)) - (goto-char (point-max)) - (beginning-of-line)) - (setq signature-string - (concat randomsig-static-string - (buffer-substring here (point)))) - (kill-buffer randomsig-buffer-name) - signature-string)))) + (let ((count 0) (selected nil)) + ;; Count number of signatures + (while (search-forward-regexp randomsig-delimiter-pattern nil t) + (setq count (1+ count))) + ;; Select random signature out out these + (setq selected (1+ (random count))) + (goto-char (point-min)) + (if (search-forward-regexp randomsig-delimiter-pattern nil t selected) + (forward-char)) + ;; Cut signature and return it + (let ((here (point)) + (signature-string nil)) + (if (not (search-forward-regexp randomsig-delimiter-pattern nil t)) + (goto-char (point-max)) + (beginning-of-line)) + (setq signature-string + (concat randomsig-static-string (buffer-substring here (point)))) + (kill-buffer randomsig-buffer-name) + signature-string)))) (defun randomsig-replace-sig (arg) @@ -412,34 +410,31 @@ When called with prefix, read the filename of the signature-file that should be used" (interactive "P") (save-excursion - (randomsig-replace-signature (randomsig-signature (if arg (randomsig-prompt "read from signature-lib: ") randomsig-files))))) - - (defun randomsig-message-read-sig (arg) "Get the signature of current message and copy it to a file. If mark is active, get the marked region instead. When called with prefix, let the user edit the signature before saving" (interactive "P") (save-excursion - (let '(signature-string + (let ((signature-string (if (randomsig-mark-active-p) (buffer-substring (point) (mark)) (progn (if (randomsig-goto-signature) - (let `(here (point)) + (let ((here (point))) (goto-char (point-max)) (while (char-equal (char-before) 10) (backward-char)) (buffer-substring here (point))) - nil)))) + nil))))) (when signature-string (if arg (progn @@ -448,7 +443,6 @@ When called with prefix, let the user edit the signature before saving" (randomsig-edit signature-string)) (randomsig-write-signature signature-string)))))) - (defun randomsig-write-signature (signature-string) (set-buffer (find-file-noselect (expand-file-name @@ -462,14 +456,13 @@ When called with prefix, let the user edit the signature before saving" (save-buffer)) -(defun gnus/randomsig-summary-read-sig (arg) - "Get the signature of current message and copy it to a file" - (interactive "P") - (progn ;save-excursion - ;; FIXME: Doesn't return to summary buffer (save-excursion should do this) - (gnus-summary-select-article-buffer) - (randomsig-message-read-sig arg))) - +;; (defun gnus/randomsig-summary-read-sig (arg) +;; "Get the signature of current message and copy it to a file" +;; (interactive "P") +;; (progn ;save-excursion +;; ;; FIXME: Doesn't return to summary buffer (save-excursion should do this) +;; (gnus-summary-select-article-buffer) +;; (randomsig-message-read-sig arg))) (defun randomsig-search-sigfiles (&optional file) "Scan `randomsig-dir' and its subdirectories for regular files. @@ -486,7 +479,7 @@ If FILE is given, only FILE and its subdirectory will be searched." ;; unwanted... nil - (let '(path (expand-file-name file randomsig-dir)) + (let ((path (expand-file-name file randomsig-dir))) (if (file-directory-p path) (mapcan (lambda (f) (randomsig-search-sigfiles (if (string= file "") @@ -568,7 +561,7 @@ You most likely do not want to call `randomsig-edit-mode' directly. \\{randomsig-edit-mode-map}" (define-key randomsig-edit-mode-map - (kbd "C-c C-c") 'randomsig-edit-done)) + (kbd "C-c C-c") 'randomsig-edit-done)) ;;; Commands for randomsig-select-mode diff --git a/lib/prog/jao-clojure.el b/lib/prog/jao-clojure.el new file mode 100644 index 0000000..7de62ba --- /dev/null +++ b/lib/prog/jao-clojure.el @@ -0,0 +1,192 @@ +;;; jao-clojure.el --- Clojure utilities -*- lexical-binding: t; -*- + +;; Copyright (C) 2025, 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: languages + +;; 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: + +;; Helpers for clojure coding + +;;; Code: + +(require 'clojure-mode) +(require 'project) +(require 'cider-test) +(require 'jao-skel) +(require 'jao-compilation) + +;;;; Jumping between implementation and test files +(defun jao-clojure--ext-dir (prefix) + (let* ((ext (file-name-extension buffer-file-name)) + (ext-rx (format "/%s/" ext))) + (if (string-match-p ext-rx buffer-file-name) + (format "%s/%s" prefix ext) + prefix))) + +(defun jao-clojure-find-current-test () + (save-excursion + (and (re-search-backward + "(deftest\\(?:\\W+^:\\w+\\)*\\W+\\b\\(.+\\)\\b" nil t) + (match-string-no-properties 1)))) + +(defvar jao-clojure--src-candidates '("lib" "src" "srv" "app")) + +(defun jao-clojure--test-namespace-p (ns) + (or (string-suffix-p "-test" ns) + (string-match "\\(.+\\)\\.\\(test\\)\\(\\..+\\)" ns))) + +(defun jao-clojure-test-buffer-p () + (jao-clojure--test-namespace-p (clojure-find-ns))) + +(defun jao-clojure--test-for (namespace sep) + (replace-regexp-in-string "\\." sep + (cider-test-default-test-ns-fn namespace))) + +(defun jao-clojure--infer-test-ns (ns) + (if (jao-clojure--test-namespace-p ns) + ns + (jao-clojure--test-for ns "."))) + +(defun jao-clojure--root () (project-root (project-current))) + +(defun jao-clojure--to-fname (x) + (replace-regexp-in-string "-" "_" x)) + +(defun jao-clojure-jump-to-test () + "Jump from implementation to test file." + (interactive) + (let* ((tn (jao-clojure--test-for (clojure-find-ns) "/")) + (bn (file-name-extension buffer-file-name)) + (f (format "%s%s/%s.%s" + (jao-clojure--root) + "test" + (jao-clojure--to-fname tn) + (jao-clojure--to-fname bn)))) + (find-file f))) + +(defun jao-clojure--implementation-for (namespace) + (thread-last (replace-regexp-in-string "-test$" "" namespace) + (replace-regexp-in-string "\\.test\\." ".") + (replace-regexp-in-string "-" "_") + (replace-regexp-in-string "\\." "/") + (substring-no-properties))) + +(defun jao-clojure--find-implementation (src) + (let ((f (format "%s%s/%s.%s" + (jao-clojure--root) + src + (jao-clojure--implementation-for (clojure-find-ns)) + (file-name-extension buffer-file-name)))) + (and (file-exists-p f) f))) + +(defun jao-clojure-jump-to-implementation () + "Jump from test file to implementation." + (interactive) + (let ((impl (car (seq-keep #'jao-clojure--find-implementation + jao-clojure--src-candidates)))) + (if impl (find-file impl) (message "No implementation file found")))) + +(defun jao-clojure-other-file () + "Toggle between implementation and test file" + (interactive) + (if (jao-clojure-test-buffer-p) + (jao-clojure-jump-to-implementation) + (jao-clojure-jump-to-test))) + +(defun jao-clojure--setup-compilation (&optional _ns) + ;; (set (make-local-variable 'compile-command) (jao-clojure--test-str ns)) + ) + +;;;; Skeletons +(defconst jao-clojure--ns-destruct-rx + (format "\\(?:%s\\|tests?\\)\\.\\(?:clj[cs]?\\.\\)?\\(.+\\)" + (regexp-opt jao-clojure--src-candidates))) + +(defun jao-clojure-buffer-namespace () + (let* ((ddir (jao-compilation-root)) + (mbase (and ddir + (concat (replace-regexp-in-string "/" "." ddir) "."))) + (mbase (and mbase + (string-match jao-clojure--ns-destruct-rx mbase) + (match-string 1 mbase)))) + (concat (or mbase "") + (replace-regexp-in-string "_" "-" (jao-skel-basename))))) + +(defvar jao-clojure--test-check-lines + (concat "[clojure.test.check :as tc]\n " + "[clojure.test.check.generators :as gen]\n " + "[clojure.test.check.properties :as prop :include-macros true]\n")) + +(defun jao-clojure--cljs-test-reqs (prefix-cmp last-cmp _test-check) + (concat " (:require [cljs.test :as t :refer-macros [is deftest async]]" + "\n [" prefix-cmp "." last-cmp " :as " last-cmp "])")) + +(defun jao-clojure--clj-test-reqs (prefix-cmp last-cmp test-check) + (format "(:use clojure.test)\n (:require %s(%s [%s :as %s]))" + (if test-check + (concat "(clojure.test.check [clojure-test :refer [defspec]])\n" + jao-clojure--test-check-lines) + "") + prefix-cmp last-cmp last-cmp)) + +(defun jao-clojure--cljc-test-reqs (prefix-cmp last-cmp test-check) + (concat "(:require #?(:clj [clojure.test :as t :refer [is deftest]]\n" + " :cljs [cljs.test :as t :refer-macros [is deftest]])\n" + (when test-check + (concat " [clojure.test.check-clojure-test #?@(" + ":cljs [:refer-macros [defspec]]\n" + ":clj [:refer [defspec]))]\n" + jao-clojure--test-check-lines)) + " [" prefix-cmp "." last-cmp " :as " last-cmp "])")) + +(defun jao-clojure--skel-ns-contents (ns) + (if (jao-clojure--test-namespace-p ns) + (let ((test-check (y-or-n-p "Include test.check requires? ")) + (ns (concat (match-string 1 ns) (match-string 3 ns)))) + (let* ((cmps (split-string ns "\\.")) + (last-cmp (car (last cmps))) + (prefix-cmp (mapconcat 'identity (butlast cmps) ".")) + (ext (file-name-extension buffer-file-name))) + (cond ((string= "cljs" ext) + (jao-clojure--cljs-test-reqs prefix-cmp last-cmp test-check)) + ((string= "cljc" ext) + (jao-clojure--cljc-test-reqs prefix-cmp last-cmp test-check)) + ((string= "clj" ext) + (jao-clojure--clj-test-reqs prefix-cmp last-cmp test-check))))) + (format "%S" (read-string "Brief module description: ")))) + +(define-skeleton jao-clojure-skeleton + "Standard Clojure module file skeleton" + "" + (jao-skel-copyright-line ";; ") + \n + (jao-skel-author-line ";; Author: ") + (jao-skel-date-line ";; Start date: ") + \n '(setq v1 (jao-clojure-buffer-namespace)) + _ "(ns " v1 + '(jao-clojure--setup-compilation v1) + \n (jao-clojure--skel-ns-contents v1) ")" + \n + '(ignore-errors (indent-region (region-beginning) (region-end))) + > -) + +(jao-skel-install "\\.clj[sc]?$" 'jao-clojure-skeleton) + + +(provide 'jao-clojure) +;;; jao-clojure.el ends here diff --git a/lib/prog/jao-compilation.el b/lib/prog/jao-compilation.el index 5bea68e..42332cd 100644 --- a/lib/prog/jao-compilation.el +++ b/lib/prog/jao-compilation.el @@ -1,6 +1,6 @@ ;;; jao-compilation.el --- utilities to lauch compilations -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022 jao +;; Copyright (C) 2020, 2021, 2022, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -33,7 +33,7 @@ (let (result) (dolist (v jao-compilation-environment result) (let ((vv (getenv v))) - (when vv (add-to-list 'result (format "%s=%s" v vv))))))) + (when vv (push (format "%s=%s" v vv) result)))))) ;;;###autoload (defun jao-compilation-add-dominating (&rest fs) @@ -68,7 +68,7 @@ ;;;###autoload (defun jao-compilation-root (&optional dir) (when-let* ((rfn (jao-compilation-find-root (or dir (buffer-file-name)) - jao-compilation-dominating-rx))) + jao-compilation-dominating-rx))) (let* ((default-directory (expand-file-name rfn)) (dir (file-name-directory rfn)) (rel-path (jao-path-relative-to dir default-directory))) @@ -108,8 +108,8 @@ ;;;###autoload (defun jao-compilation-setup () (jao-compilation-add-dominating - "Makefile" "makefile" "configure.ac" "bootstrap.sh" "aclocal.m4" - "project.clj" "build.xml" "pom.xml" "setup.py" "stack.yaml") + "Makefile" "makefile" "configure.ac" "Cargo.toml" + "deps.edn" "project.clj" "build.xml" "pom.xml" "setup.py" "stack.yaml") (with-eval-after-load "project" (add-to-list 'project-find-functions #'jao-find-compilation-root t))) diff --git a/lib/prog/jao-rust.el b/lib/prog/jao-rust.el new file mode 100644 index 0000000..1b2f736 --- /dev/null +++ b/lib/prog/jao-rust.el @@ -0,0 +1,160 @@ +;;; jao-rust.el --- Utilities for rust programming -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Jose Ruiz + +;; Author: Jose Ruiz <mail@jao.io> +;; Keywords: languages + +;; 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/>. + +;;; Code: + +(declare-function rustic-cargo-bin "rustic") +(declare-function rustic-run-cargo-command "rustic") +(defvar rustic-cargo-test-runner) +(defvar rustic-cargo-use-last-stored-arguments) +(defvar rustic-default-test-arguments) +(defvar rustic-test-arguments) + +(defun jao-rust--root () + (locate-dominating-file default-directory "Cargo.toml")) + +(defun jao-rust-open-cargo () + (interactive) + (let ((f (expand-file-name "Cargo.toml" (jao-rust--root)))) + (when (or (file-exists-p f) + (y-or-n-p "No Cargo.toml found. Create? ")) + (find-file f)))) + +(defun jao-rust-current-module-name () + (let* ((root (expand-file-name (jao-rust--root))) + (current (file-name-sans-extension (buffer-file-name))) + (rel (string-replace root "" current))) + (and (string-prefix-p "src/" rel) + (thread-last + rel + (replace-regexp-in-string "^src\\(/bin\\)?/" "") + (string-replace "-" "_") + (replace-regexp-in-string "\\(^\\|/\\)\\(mod\\|lib\\|main\\)$" "") + (string-replace "/" "::"))))) + +(defun jao-rust-crate-name () + (file-name-nondirectory + (replace-regexp-in-string "/$" "" (or (jao-rust--root) "")))) + +;;;###autoload +(define-minor-mode jao-rust-show-module-mode + "Show the current file's module in the mode line lighter" + :lighter (:eval (if-let* ((m (jao-rust-current-module-name)) + (c (jao-rust-crate-name))) + (format " %s::%s" c m)))) + +(defun jao-rust--tests-prefix () + (let ((m (jao-rust-current-module-name))) + (cond ((not (stringp m)) "") + ((string-empty-p m) "tests::") + (t (concat m "::tests::"))))) + +(defconst jao-rust--test-header-rx + (concat "#\\[" (regexp-opt '("test" "quickcheck" "tokio::test") t))) + +(defconst jao-rust--test-name-rx "^ *\\(pub \\)?\\( async \\)?fn \\([^(]+\\)(") + +(defun jao-rust-test-at-point () + (when (looking-at jao-rust--test-name-rx) (match-string-no-properties 3))) + +(defun jao-rust-test-before-point () + (save-excursion + (when (re-search-backward jao-rust--test-header-rx nil t) + (forward-line) + (jao-rust-test-at-point)))) + + +(defconst jao-rust--tests-mod-rx "^\\(pub\\)? *mod tests {") + +;;;###autoload +(defun jao-rust-goto-tests () + (interactive) + (or (re-search-forward jao-rust--tests-mod-rx nil t) + (re-search-backward jao-rust--tests-mod-rx nil t) + (progn + (goto-char (point-min)) + (re-search-forward jao-rust--test-header-rx nil t)) + (when (y-or-n-p "No tests module. Add it?") + (goto-char (point-max)) + (insert "\n#[cfg(test)]\nmod tests {\n\n}") + (forward-line -1)))) + +;;;###autoload +(defun jao-rust-test-current () + (interactive) + (if-let* ((m (jao-rust--tests-prefix)) + (n (jao-rust-test-before-point))) + (let ((rustic-test-arguments (format "-- --exact %s%s" m n)) + (rustic-cargo-use-last-stored-arguments t)) + (rustic-cargo-test)) + (message "No test before point"))) + +(defun jao-rust-buffer-tests () + (save-excursion + (goto-char (point-min)) + (let ((res '())) + (while (re-search-forward jao-rust--test-header-rx nil t) + (forward-line) + (when-let* ((name (jao-rust-test-at-point))) (push name res))) + res))) + +;;;###autoload +(defun jao-rust-test-module () + (interactive) + (let ((tests (jao-rust-buffer-tests))) + (if (seq-empty-p tests) + (when (y-or-n-p "No tests in this module. Run doc tests?") + (jao-rust-test-doctests)) + (let* ((prefix (jao-rust--tests-prefix)) + (tests (mapconcat (lambda (x) (format "%s%s" prefix x)) tests " ")) + (rustic-test-arguments (format "-- --exact %s" tests)) + (rustic-cargo-use-last-stored-arguments t)) + (rustic-cargo-test))))) + +;;;###autoload +(defun jao-rust-test-doctests (&optional all) + (interactive "P") + (let* ((m (if all "" (jao-rust-current-module-name))) + (rustic-cargo-test-runner 'cargo) + (rustic-test-arguments (format "--doc %s" m)) + (rustic-cargo-use-last-stored-arguments t)) + (rustic-cargo-test))) + +;;;###autoload +(defun jao-rust-retest () + (interactive) + (let* ((rustic-test-arguments "-R latest") + (rustic-cargo-use-last-stored-arguments t)) + (rustic-cargo-test))) + +;;;###autoload +(defun jao-rust-test-workspace () + (interactive) + (let ((rustic-test-arguments rustic-default-test-arguments)) + (rustic-cargo-test))) + + +;;;###autoload +(defun jao-rust-build-doc (deps) + (interactive "P") + (rustic-run-cargo-command `(,(rustic-cargo-bin) "doc" ,@(unless deps '("--no-deps"))))) + +(provide 'jao-rust) +;;; jao-rust.el ends here diff --git a/lib/prog/jao-sloc.el b/lib/prog/jao-sloc.el index 1f0e9ab..a325871 100644 --- a/lib/prog/jao-sloc.el +++ b/lib/prog/jao-sloc.el @@ -1,4 +1,4 @@ -;; sloc.el -- LOC utilities +;; sloc.el -- LOC utilities -*- lexical-binding: t; -*- ;;;###autoload (defun count-sloc-region (beg end kind) diff --git a/lib/prog/jao-vterm-repl.el b/lib/prog/jao-vterm-repl.el deleted file mode 100644 index 699ff39..0000000 --- a/lib/prog/jao-vterm-repl.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; jao-vterm-repl.el --- vterm-based repls -*- lexical-binding: t; -*- - -;; Copyright (C) 2020, 2021 jao - -;; Author: jao <mail@jao.io> -;; Keywords: terminals - -;; 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: - -;; Helpers to launch reply things such as erlang shells inside a vterm. -;; For instance, to declare an erl repl for rebar projects, one would call: -;; -;; (jao-vterm-repl-register "rebar.config" "rebar3 shell" "^[0-9]+> ") - -;;; Code: - -(require 'jao-compilation) - -(declare-function 'vterm-copy-mode "vterm") -(declare-function 'vterm-send-string "vterm") -(declare-function 'vterm-send-return "vterm") - -(defun jao-vterm-repl--buffer-name (&optional dir) - (format "*vterm -- repl - %s*" (or dir (jao-compilation-root)))) - -(defvar jao-vterm-repl-repls nil) -(defvar jao-vterm-repl-prompts nil) -(defvar-local jao-vterm-repl--name nil) -(defvar-local jao-vterm-repl--last-buffer nil) -(defvar-local jao-vterm-repl--prompt-rx "^[0-9]+> ") - -(setq vterm-buffer-name-string nil) - -(defun jao-vterm-repl--exec (cmd &optional name) - (vterm name) - (when name - (vterm-send-string "unset PROMPT_COMMAND\n\n")) - (vterm-send-string cmd) - (vterm-send-return) - (when name (rename-buffer name t))) - -;;;###autoload -(defun jao-vterm-repl-previous-prompt () - (interactive) - (when (derived-mode-p 'vterm-mode) - (vterm-copy-mode 1) - (forward-line 0) - (when (re-search-backward jao-vterm-repl--prompt-rx nil t) - (goto-char (match-end 0))))) - -;;;###autoload -(defun jao-vterm-repl-next-prompt () - (interactive) - (when (derived-mode-p 'vterm-mode) - (vterm-copy-mode 1) - (or (re-search-forward jao-vterm-repl--prompt-rx nil t) - (vterm-copy-mode -1)) - (unless (save-excursion - (re-search-forward jao-vterm-repl--prompt-rx nil t)) - (vterm-copy-mode -1)))) - -;;;###autoload -(define-minor-mode jao-vterm-repl-mode "repl-aware vterm" nil nil - '(("\C-c\C-p" . jao-vterm-repl-previous-prompt) - ("\C-c\C-n" . jao-vterm-repl-next-prompt) - ("\C-c\C-z" . jao-vterm-repl-pop-to-src))) - -;;;###autoload -(defun jao-vterm-repl () - (let* ((dir (jao-compilation-root)) - (vname (jao-vterm-repl--buffer-name dir)) - (root-name (jao-compilation-root-file)) - (buffer (seq-find `(lambda (b) - (string= - (buffer-local-value 'jao-vterm-repl--name - b) - ,vname)) - (buffer-list)))) - (or buffer - (let ((default-directory dir) - (prompt (cdr (assoc root-name jao-vterm-repl-prompts))) - (cmd (or (cdr (assoc root-name jao-vterm-repl-repls)) - (read-string "REPL command: "))) - (bname (format "* vrepl - %s/%s *" - (file-name-base (string-remove-suffix "/" dir)) - root-name))) - (jao-vterm-repl--exec cmd bname) - (jao-vterm-repl-mode) - (setq-local jao-vterm-repl--name vname) - (when prompt (setq-local jao-vterm-repl--prompt-rx prompt)) - (current-buffer))))) - -;;;###autoload -(defun jao-vterm-repl-register (build-file repl-cmd prompt-rx) - (jao-compilation-add-dominating build-file) - (add-to-list 'jao-vterm-repl-repls (cons build-file repl-cmd)) - (add-to-list 'jao-vterm-repl-prompts (cons build-file prompt-rx))) - -;;;###autoload -(defun jao-vterm-repl-pop-to-repl () - (interactive) - (let ((bn (current-buffer))) - (pop-to-buffer (jao-vterm-repl)) - (setq-local jao-vterm-repl--last-buffer bn))) - -;;;###autoload -(defun jao-vterm-repl-pop-to-src () - (interactive) - (when (buffer-live-p jao-vterm-repl--last-buffer) - (pop-to-buffer jao-vterm-repl--last-buffer))) - -;;;###autoload -(defun jao-vterm-repl-send (cmd) - (with-current-buffer (jao-vterm-repl) (vterm-send-string cmd))) - -(provide 'jao-vterm-repl) -;;; jao-vterm-repl.el ends here diff --git a/lib/readme.org b/lib/readme.org index ca494f4..35faccb 100644 --- a/lib/readme.org +++ b/lib/readme.org @@ -5,5 +5,5 @@ - [[./media][media]] utilities for music players and the like - [[./prog][prog]] utilities for compilation and programming modes - [[./net][net]] utilities for networking (w3m, weather &c.) - - [[./themes][themes]] color themes based on Emacs builtin custom themes + - [[./wm][wm]] utilities for interacting with window managers - [[./skels][skels]] a collection of emacs skeletons diff --git a/lib/skels/jao-skel-cpp.el b/lib/skels/jao-skel-cpp.el index 0ddb61e..1180495 100644 --- a/lib/skels/jao-skel-cpp.el +++ b/lib/skels/jao-skel-cpp.el @@ -1,6 +1,6 @@ ;;; jao-skel-cpp.el -*- lexical-binding: t; -*- -;; Copyright (C) 2004, 2005, 2008, 2009, 2022 Jose Antonio Ortega Ruiz +;; Copyright (C) 2004, 2005, 2008, 2009, 2022, 2026 Jose Antonio Ortega Ruiz ;; Author: Jose A Ortega Ruiz <jao@gnu.org> ;; Keywords: tools @@ -50,7 +50,7 @@ ;;; Auxiliar functions (defun jao-skel-cpp--find-other (ext) (file-name-nondirectory - (or (ff-other-file-name) + (or (ff-get-other-file) (concat (file-name-sans-extension (buffer-name)) "." ext)))) (defun jao-skel-cpp-make-guard-name (ns) @@ -68,7 +68,7 @@ (defsubst jao-skel-cpp--ns2str (ns) (mapconcat 'identity ns "::")) (defun jao-skel-cpp--get-ns-list (&optional acc) - (do* ((result acc (cons next result)) + (cl-do* ((result acc (cons next result)) (next (jao-skel-cpp--read-ns (jao-skel-cpp--ns2str acc)) (jao-skel-cpp--read-ns (jao-skel-cpp--ns2str (reverse result))))) ((string= next "") (reverse result)))) @@ -98,11 +98,11 @@ (while (re-search-forward "namespace\\s-\\w+\\s-{\\|}+\\s-//\\s-namespace" nil t) (push (thing-at-point 'line) lines) - (next-line))) + (forward-line))) lines)) (defun jao-skel-cpp--copy-namespace () - (let* ((name (ff-other-file-name)) + (let* ((name (ff-get-file-name)) (buff (and name (find-file-noselect name))) (nlines)) (when buff diff --git a/lib/themes/jao-dark-theme.el b/lib/themes/jao-dark-theme.el deleted file mode 100644 index 9e07f1a..0000000 --- a/lib/themes/jao-dark-theme.el +++ /dev/null @@ -1,136 +0,0 @@ -;;; jao-dark-theme.el --- a dark theme with blue-green accent -*- lexical-binding: t; -*- - -;; Author: jao <mail@jao.io> -;; Keywords: themes - -;; 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/>. - -(defvar jao-theme-dark-bold - (if (> emacs-major-version 28) 'medium 'semibold)) - -(jao-define-custom-theme jao-dark - (:names (bg "#282b33" nil nil) - (bg-alt "#1f2024" nil nil) - (fg "#c6c6c6") - (fg-0.5 "#a6a6a6") - (fg-1 "#868686") - (fg-2 "#666666") - (blue "#819cd6") - (blueish "#6e7899") - (dark-blue "#616c96") - (green "#5b94ab") - (yellow "antiquewhite3") - (dark-yellow "antiquewhite4") - (orange "#a6c1e0") - (orange2 "#dd8844") - (red "#e1c1ee" "#ff6655" "red") - (comments "azure4" "lightblue4") - (constants "honeydew4") - (dimm-line-fg "#3f3f3f") - (dimm-line "#7f7f7f") - (error "#e1c1ee") - (functions "#7ebebd") - (functions2 "#44b9b1") - (keywords "cadetblue3") - (keywords2 "#51afef") - (modeline-bg "#22242b") - (modeline-bg-inactive "#24262d") - ;;(region "#41454b") - (region "#31353b") - (strings "honeydew3") - (success "#5b94ab") - (warning "#cfcf9c") - (warning2 "#ECBE7B")) - (:face-family "Fira Code") - (:face-size 9) - (:bold-weight jao-theme-dark-bold) - (:palette (fg "#c6c6c6") - (bg "#1f2024") - (box "grey25") - (button (p f12) bx nul) - (hilite (c nil region) ex) - (link (ul dark-blue)) ;; (ul dimm-line) - (visited-link (ul dark-blue)) - (tab-sel (c 252 232) nbf) - (tab-unsel (c 245 232)) - (comment (c comments)) - (keyword (c keywords)) - (function (c functions)) - (type (c constants)) - (variable-name (c nil)) - (constant (c constants)) - (string (c strings) it) - (error (c warning2)) - (warning (c warning)) - (success (c green)) - (dimm (c dimm-line)) - (gnus-mail (c nil)) - (gnus-news (c nil)) - (outline-1 (c strings) nbf) - (outline-2 (c functions) nbf) - (outline-3 (c blue) nbf) - (outline-4 (c functions2) nbf) - (outline-5 (c nil)) - (f00 (c "lightskyblue3")) - (f01 (c "lightskyblue4")) - (f02 (c "lightblue3")) - (f10 (c "lightblue4")) - (f11 (c "lightblue2")) - (f12 (c "azure3"))) - (:x-faces (clojure-keyword-face (c "powder blue")) - (corfu-background (c "white" "grey20")) - (corfu-bar (c nil "grey20")) ;; moving part of the bar - (corfu-border (~ corfu-background)) ;; background of the bar - (corfu-current (c "white" "grey50") nbf nit nul) - (corfu-echo (~ default)) - (cursor (c warning2 warning2)) - (diff-hl-change (c green)) - (diff-hl-delete (c orange2) bf) - (diff-hl-insert (c dark-blue)) - (fill-column-indicator (c "black") :inherit nil) - (font-lock-doc-face (~ font-lock-comment-face) it) - (fringe (p dimm)) - (gnus-button (c "lightyellow3")) - (gnus-cite-1 (c fg-0.5)) - (gnus-cite-2 (c fg-1)) - (gnus-cite-3 (c fg-2)) - (gnus-cite-4 (c fg-2)) - ;; (gnus-group-mail-3 (c yellow)) - ;; (gnus-group-mail-3-empty (c fg-0.5)) - ;; (gnus-group-news-3 (~ gnus-group-mail-3)) - ;; (gnus-group-news-3-empty (~ gnus-group-mail-3-empty)) - ;; (gnus-group-mail-low (p f10)) - ;; (gnus-group-mail-low-empty (~ gnus-group-mail-3-empty)) - (gnus-summary-cancelled (c "dark slate gray" nil) st) - (gnus-summary-selected (p warning) nul nbf) - (header-line (p hilite)) - (magit-diff-context-highlight (p hilite) ex) - (mode-line (c "grey60" modeline-bg) - :box (:line-width 1 :color "#282b33")) - (mode-line-inactive (c "grey35" modeline-bg-inactive) - :box (:line-width 1 :color "#282b33")) - (mode-line-buffer-id (c yellow)) - (org-hide (c 0 nil)) - (org-code (c yellow)) - (scroll-bar (c bg)) - (show-paren-match (c "darkseagreen1" "#5f5f5f")) - (shr-link (c blue) (ul dark-blue)) - (vertical-border (c "black") :inherit nil) - (vertico-group-separator (p dimm) :strike-through "#6f6f6f"))) - -;; (enable-theme 'jao-dark) -;; (jao-mode-line-adjust-faces) - - -(provide 'jao-dark-theme) diff --git a/lib/themes/jao-light-term-theme.el b/lib/themes/jao-light-term-theme.el deleted file mode 100644 index ccd6a3f..0000000 --- a/lib/themes/jao-light-term-theme.el +++ /dev/null @@ -1,121 +0,0 @@ -;;; jao-light-term-theme.el --- a light theme -*- lexical-binding: t; -*- - -;; Author: jao <mail@jao.io> -;; Keywords: themes - -;; 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/>. - -(jao-define-custom-theme jao-light-term - (:names (bg-lightest "gray98") - (bg-light "gray95") - - (light-gray "gray80") - - (black "black") - (dark-gray "gray30") - (fg-light "gray40") - - ;; (hl "#f2f2f2") - (hl "ivory2") - (dimm "lemonchiffon4") - - (warning "orange4") - (red "burlywood4") - (blue "#023770") - (green "#005555") - (lightgreen "darkgreen") - (yellow "lightyellow")) - (:face-size 9) - (:face-family "DejaVu Sans Mono") - (:bold-weight 'bold) - (:palette (fg "#000000") - (bg "#ffffff") - (box "gray80") - (hilite (c nil hl)) - (link (c green) nbf nul) - (visited-link (c green)) - (tab-sel (~ mode-line)) - (tab-unsel (~ mode-line-inactive)) - (comment (c fg-light) it) - (keyword (c blue) bf) - (type (c blue) nbf) - (function (c green)) - (variable-name (c black)) - (constant (c dark-gray)) - (string (c blue) nit) - (warning (c warning)) - (error (c red) bf) - (dimm (c dimm)) - (gnus-mail (c "black")) - (gnus-news (c "black")) - (outline (c "black") bf) - (outline-1 (c green) nbf nul ex) - (outline-2 (c blue) nbf) - (outline-3 (c lightgreen) nbf) - (outline-4 (c blue) nul nbf) - (outline-5 (c blue) nul nbf) - (f00 (c green)) - (f01 (c blue)) - (f02 (c dark-gray)) - (f10 (p f00)) - (f11 (p f01)) - (f12 (p f02))) - (:x-faces (button (c blue bg-lightest)) - (compilation-info (c "#223142" nil) nbf) - (completions-group-separator (c nil ni) (st "grey80")) - (corfu-default (~ default) (c "black" "grey95")) - (corfu-bar (c nil "grey80")) ;; moving part of the bar - (corfu-border (~ corfu-background)) ;; background of the bar - (corfu-current (c "black" "grey95") nbf nit (ul "grey70")) - (cursor (c "sienna3" "sienna3")) - (diff-hl-margin-change (c "lightcyan2" nil)) - (diff-hl-margin-insert (c "honeydew2" nil)) - (diff-hl-margin-delete (c "wheat1" nil)) - (eww-form-text (p hilite)) - (fill-column-indicator (c "grey80")) - (fringe (c "grey70" nil)) - (gnus-button (c blue)) - (gnus-cite-1 (c "darkslategray" nil)) - (gnus-cite-2 (c "slate gray" nil)) - (gnus-cite-3 (c "slate gray" nil)) - (gnus-cite-4 (c "slate gray" nil)) - (gnus-header-name (c fg-light)) - (gnus-summary-selected (c green) nbf) - (gnus-summary-cancelled (c "sienna3" nil) st) - (header-line (c dark-gray bg-lightest) - :box (:line-width 1 :color "grey90")) - (magit-diff-context-highlight (c nil hl) ex) - (magit-diff-hunk-heading-highlight (c nil hl) it bf) - (mode-line (c "grey20" "gray90") nbf) - (mode-line-inactive (c "grey40" "gray95")) - (mode-line-buffer-id (~ default) (c dark-blue-2 nil) nit) - (mode-line-emphasis (c green nil)) - (mode-line-highlight (c green nil)) - (org-link (p link) (ul "grey80")) - (scroll-bar (c "grey90" nil)) - (show-paren-match (c nil "grey85")) - (shr-text (c nil nil)) - (shr-link (~ link) (ul light-gray)) - (shr-code (c blue nil)) - (success (c green)) - (vertical-border (c "grey70" nil)) - (vertico-current (c nil yellow) nul ext) - (widget-button (c blue nil) nit nul) - (widget-field (c nil bg-light) nit nul) - (whitespace-tag (p hilite)))) - -;; (enable-theme 'jao-light-term) -;; (jao-mode-line-adjust-faces) - -(provide 'jao-light-term-theme) diff --git a/lib/themes/jao-light-theme.el b/lib/themes/jao-light-theme.el deleted file mode 100644 index 659b6bb..0000000 --- a/lib/themes/jao-light-theme.el +++ /dev/null @@ -1,126 +0,0 @@ -;;; jao-light-theme.el --- a light theme -*- lexical-binding: t; -*- - -;; Author: jao <mail@jao.io> -;; Keywords: themes - -;; 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/>. - -(jao-define-custom-theme jao-light - (:names (bg-lightest "gray98") - (bg-light "gray95") - - (light-gray "gray80") - - (black "black") - (dark-gray "gray30") - (fg-light "gray40") - - (hl "#f2f2f2") - (dimm "lemonchiffon4") - - (warning "orange4") - (red "burlywood4") - (blue "#023770") - (pale-blue "honeydew3") - (green "#005555") - (lightgreen "darkgreen") - (yellow "lightyellow")) - (:face-size 9) - ;; (:face-family "DejaVu Sans Mono") - (:face-family "Hack") - (:bold-weight 'semibold) - (:palette (fg "black") - (bg "white") - (box "gray80") - (hilite (c nil hl)) - (button (c fg-light bg-lightest) (ul light-gray)) - (link (c green) nbf (ul light-gray)) - (visited-link (ul light-gray) nbf) - (tab-sel (~ mode-line)) - (tab-unsel (~ mode-line-inactive)) - (comment (c fg-light) it) - (keyword (c blue) bf) - (type (c blue) nbf) - (function (c green)) - (variable-name (c black)) - (constant (c dark-gray)) - (string (c blue) nit) - (warning (c warning)) - (error (c red) bf) - (dimm (c dimm)) - (gnus-mail (c "black")) - (gnus-news (c "black")) - (outline (c "black") bf) - (outline-1 (c green) bf) - (outline-2 (c green) nbf) - (outline-3 (c blue) nul nbf) - (outline-4 (c blue) nul nbf) - (outline-5 (c blue) nul nbf) - (f00 (c green)) - (f01 (c blue)) - (f02 (c dark-gray)) - (f10 (p f00)) - (f11 (p f01)) - (f12 (p f02))) - (:x-faces (compilation-info (c "#223142" nil) nbf) - (completions-group-separator (c nil ni) (st "grey80")) - (corfu-default (~ default) (c "black" "grey95")) - (corfu-bar (c nil "grey80")) ;; moving part of the bar - (corfu-border (~ corfu-background)) ;; background of the bar - (corfu-current (c "black" "grey95") nbf nit (ul "grey70")) - (cursor (c "sienna3" "sienna3")) - (diff-hl-change (c "white" "honeydew2")) - (diff-hl-insert (c "white" "lemonchiffon2")) - (diff-hl-delete (c "white" "wheat1")) - (diff-hl-margin-change (c pale-blue)) - (diff-hl-margin-insert (c pale-blue)) - (diff-hl-margin-delete (c "wheat1")) - (fill-column-indicator (c "grey80")) - (fringe (c "grey70" nil)) - (gnus-button (c blue)) - (gnus-cite-1 (c "darkslategray" nil)) - (gnus-cite-2 (c "slate gray" nil)) - (gnus-cite-3 (c "slate gray" nil)) - (gnus-cite-4 (c "slate gray" nil)) - (gnus-header-name (c fg-light)) - (gnus-summary-selected (c green) nbf) - (gnus-summary-cancelled (c "sienna3" nil) st) - (header-line (c dark-gray bg-lightest) - :box (:line-width 1 :color "grey90")) - (magit-diff-context-highlight (c nil yellow) ex) - (magit-diff-hunk-heading-highlight (c nil hl) it bf) - (message-header-subject (p warning) nbf) - (mode-line (c "grey20") :box (:line-width 1 :color "grey80")) - (mode-line-inactive - (c "grey40" bg-light) :box (:line-width 1 :color "grey80")) - (mode-line-buffer-id (~ default) (c nil nil) nit) - (mode-line-emphasis (c green nil)) - (mode-line-highlight (c green nil)) - (org-link (p link) (ul "grey80")) - (tab-bar (~ header-line) :family "Source Code Pro") - (scroll-bar (c "grey80" nil)) - (show-paren-match (c nil "grey85")) - (shr-text (c nil nil)) - (shr-link (~ link) (ul light-gray)) - (shr-code (c blue nil)) - (success (c green)) - (variable-pitch :family "Iosevka Etoile" :height 90) - (vertical-border (c "grey70" nil)) - (vterm-color-yellow (c "darkgoldenrod4" yellow)) - (widget-button (~ default) nit (ul "grey80")))) - -;; (enable-theme 'jao-light) -;; (jao-mode-line-adjust-faces) - -(provide 'jao-light-theme) diff --git a/lib/wm/jao-exwm-zathura.el b/lib/wm/jao-exwm-zathura.el new file mode 100644 index 0000000..0a11dbb --- /dev/null +++ b/lib/wm/jao-exwm-zathura.el @@ -0,0 +1,148 @@ +;;; jao-exwm-zathura.el --- running zathura as doc manager -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 jao + +;; Author: jao <mail@jao.io> +;; Keywords: docs + +;; 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-exwm) +(require 'jao-pdf) +(require 'jao-doc-view) +(require 'jao-afio) +(require 'jao-org-notes) + +;;; Zathura support +(defun jao-zathura--buffer-p (b) + (string= "Zathura" (or (buffer-local-value 'exwm-class-name b) ""))) + +(defun jao-zathura--buffers () + (seq-filter #'jao-zathura--buffer-p (buffer-list))) + +(defun jao-zathura--file-info (b) + (with-current-buffer b + (jao-pdf-zathura-file-info (or exwm-title "")))) + +(defun jao-zathura-goto-page (page-no) + (jao-exwm-send-str (format "%sg" page-no))) + +;;;###autoload +(defun jao-zathura-open-doc (&optional file-name page-no _height) + (interactive) + (let* ((file-name (expand-file-name (or file-name (buffer-file-name)))) + (buffer (seq-find `(lambda (b) + (string= ,file-name + (car (jao-zathura--file-info b)))) + (jao-zathura--buffers))) + (page-no (or page-no (jao-doc-view-current-page)))) + (when jao-exwm-use-afio (jao-afio-goto-docs)) + (if (not buffer) + (jao-exwm-run (if page-no + (format "zathura -P %s '%s'" page-no file-name) + (format "zathura '%s'" file-name))) + (pop-to-buffer buffer) + (when page-no (jao-zathura-goto-page page-no))) + (current-buffer))) + +(defun jao-exwm--zathura-setup () + (when (and (string= exwm-class-name "Zathura") + (not jao-pdf--outline)) + (let ((info (jao-zathura--file-info (current-buffer)))) + (jao-doc-session-mark (car info)) + (jao-doc-session-save) + (doc-view-imenu-index (car info) #'jao-zathura-goto-page)))) + +;;;###autoload +(defun jao-exwm-pdf-zathura-close-all () + (interactive) + (dolist (b (jao-zathura--buffers)) + (ignore-errors + (switch-to-buffer b) + (jao-exwm-send-str "q"))) + t) + +;;;###autoload +(defun jao-exwm-zathura-goto-org (&optional arg) + (interactive "P") + (when-let* ((info (jao-zathura--file-info (current-buffer))) + (file (jao-org-notes-find-for-pdf (car info)))) + (let ((newp (not (file-exists-p file)))) + (when (or arg newp) (org-store-link nil t)) + (find-file-other-window file) + (when newp + (jao-org-insert-doc-skeleton) + (org-insert-link))))) + +;;;###autoload +(defun jao-exwm-zathura-goto-org* () + (interactive) + (jao-exwm-zathura-goto-org t)) + +;;;###autoload +(defun jao-exwm-org-store-zathura-link () + (when-let* ((info (jao-zathura--file-info (current-buffer)))) + (let* ((file-name (car info)) + (page (cadr info)) + (desc (jao-pdf-section-title page file-name))) + (jao-org-links-store-pdf-link file-name page desc)))) + +;;;###autoload +(defun jao-exwm-pdf-enable-zathura () + (interactive) + (add-hook 'kill-emacs-query-functions #'jao-exwm-pdf-zathura-close-all t) + (add-hook 'exwm-update-title-hook #'jao-exwm--zathura-setup t) + (with-eval-after-load "org" + (define-key org-mode-map (kbd "C-c o") #'jao-exwm-zathura-goto-pdf)) + (setq jao-pdf-open-in-emacs nil) + (setq jao-org-open-pdf-fun #'jao-zathura-open-doc) + (setq jao-org-links-pdf-store-fun #'jao-exwm-org-store-zathura-link) + (setq jao-open-doc-fun #'jao-zathura-open-doc)) + +;;;###autoload +(defun jao-exwm-pdf-disable-zathura () + (interactive) + (remove-hook 'kill-emacs-query-functions #'jao-exwm-pdf-zathura-close-all) + (remove-hook 'exwm-update-title-hook #'jao-exwm--zathura-setup) + (setq jao-pdf-open-in-emacs t) + (setq jao-org-open-pdf-fun #'jao-find-or-open) + (setq jao-org-links-pdf-store-fun nil) + (setq jao-open-doc-fun #'jao-find-or-open)) + +;;;###autoload +(defun jao-exwm-org-to-pdf-file () + (expand-file-name (concat "doc/" (file-name-base buffer-file-name) ".pdf") + (file-name-directory jao-org-notes-dir))) + +;;;###autoload +(defun jao-exwm-zathura-goto-pdf () + (interactive) + (if jao-pdf-open-in-emacs + (jao-org-goto-pdf) + (when-let* ((pdf (jao-exwm-org-to-pdf-file))) + (jao-zathura-open-doc pdf)))) + +(defun jao-exwm-select-pdf () + (interactive) + (let ((b (read-buffer "Document: " nil t + (lambda (b) + (let ((b (cdr b))) + (or (jao-zathura--buffer-p b) + (member (buffer-local-value 'major-mode b) + '(pdf-view-mode doc-view-mode)))))))) + (jao-afio-goto-docs) + (pop-to-buffer b))) + +(provide 'jao-exwm-zathura) +;;; jao-exwm-zathura.el ends here diff --git a/lib/wm/jao-exwm.el b/lib/wm/jao-exwm.el new file mode 100644 index 0000000..60eb72b --- /dev/null +++ b/lib/wm/jao-exwm.el @@ -0,0 +1,240 @@ +;;; jao-exwm.el --- exwm utilities -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 jao + +;; Author: jao <mail@jao.io> + +;; 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/>. + +;;; Deps +(require 'browse-url) +(require 'exwm) +(require 'jao-afio) +(require 'jao-minibuffer) +(require 'exwm-systemtray) + +;;; Helpers +(defvar jao-exwm-use-afio t) + +(defun jao-exwm-send-str (str) + (dolist (k (string-to-list str)) + (exwm-input--fake-key k))) + +;;; Minibuffer and system tray +(defun jao-exwm--watch-tray (_sym newval _op _where) + (setq jao-minibuffer-right-margin (/ newval (string-pixel-width "a"))) + (jao-minibuffer-refresh)) + +;;;###autoload +(defun jao-exwm-set-up-minibuffer () + ;; (setq jao-minibuffer-frame-width 271) + (add-hook 'exwm-workspace-switch-hook #'jao-minibuffer-refresh) + (exwm-systemtray-mode 1) + (add-variable-watcher 'exwm-systemtray-width #'jao-exwm--watch-tray)) + +;;; Buffers +(defvar-local jao-exwm--name nil) +(defvar jao-exwm--current-name nil) + +(defun jao-exwm--check-name (name) + (or (string= jao-exwm--name name) + (string= (buffer-name) name) + (string= exwm-class-name name) + (string= exwm-title name))) + +(defun jao-exwm-find-class-buffer (cln) + (if (jao-exwm--check-name cln) + (current-buffer) + (let* ((cur-buff (current-buffer)) + (bfs (seq-filter (lambda (b) + (and (not (eq b cur-buff)) + (with-current-buffer b + (jao-exwm--check-name cln)))) + (buffer-list)))) + (when (car bfs) (car (reverse bfs)))))) + +(defun jao-exwm-switch-to-class/title (cln) + (interactive) + (when cln + (if (jao-exwm--check-name cln) + (current-buffer) + (when-let* ((b (jao-exwm-find-class-buffer cln))) + (pop-to-buffer b))))) + +(defun jao-exwm-switch-to-next-class () + (interactive) + (jao-exwm-switch-to-class/title exwm-class-name)) + +(defun jao-exwm-switch-to-next-x () + (interactive) + (let ((bfs (seq-filter (lambda (b) + (with-current-buffer b + (derived-mode-p 'exwm-mode))) + (buffer-list (window-frame))))) + (when (car bfs) (switch-to-buffer (car (reverse bfs)))))) + +;;; Buffer names +(defun jao-exwm--use-title-p () + (and exwm-title (not (string-blank-p exwm-title)))) + +(defun jao-exwm-rename-buffer/class () + (unless (jao-exwm--use-title-p) + (exwm-workspace-rename-buffer exwm-class-name))) + +(defun jao-exwm-rename-buffer/title () + (cond ((or (not exwm-instance-name) + (jao-exwm--use-title-p)) + (exwm-workspace-rename-buffer exwm-title)) + ((string= "Zathura" exwm-class-name) + (exwm-workspace-rename-buffer + (format "zathura: %s" (file-name-nondirectory exwm-title)))))) + +(defun jao-exwm--set-exwm-name () + (when (not jao-exwm--name) + (setq jao-exwm--name jao-exwm--current-name + jao-exwm--current-name nil))) + +;;;###autoload +(defun jao-exwm-set-up-buffer-handling () + (add-hook 'exwm-mode-hook 'jao-exwm--set-exwm-name) + (add-hook 'exwm-update-class-hook 'jao-exwm-rename-buffer/class) + (add-hook 'exwm-update-title-hook 'jao-minibuffer-refresh) + (add-hook 'exwm-update-title-hook 'jao-exwm-rename-buffer/title)) + +;;; Float windows +(defvar jao-exwm-max-x (x-display-pixel-width)) +(defvar jao-exwm-max-y (x-display-pixel-height)) + +(defun jao-exwm--float-to (x y &optional w h) + (let* ((w (or w (frame-pixel-width))) + (h (or h (frame-pixel-height))) + (x (if (< x 0) (- jao-exwm-max-x (- x) w) x)) + (y (if (< y 0) (- jao-exwm-max-y (- y) h) y)) + (p (or (frame-parameter nil 'jao-position) (frame-position)))) + (exwm-floating-move (- x (car p)) (- y (cdr p))) + (exwm-layout-enlarge-window-horizontally (- w (frame-pixel-width))) + (exwm-layout-enlarge-window (- h (frame-pixel-height))) + (set-frame-parameter nil 'jao-position (cons x y)))) + +(defun jao-exwm--center-float (&optional w h) + (interactive) + (let* ((mx jao-exwm-max-x) + (my jao-exwm-max-y) + (w (or w (frame-pixel-width))) + (h (or h (/ (* w my) mx)))) + (jao-exwm--float-to (/ (- mx w) 2) (/ (- my h) 2) w h))) + +(defun jao-exwm--setup-float () + (set-frame-parameter nil 'jao-position nil) + (cond ((member exwm-class-name '("firefox" "Firefox" "Sofice")) + (jao-exwm--center-float 900 600)) + ((member exwm-class-name '("mpv" "vlc")) + (jao-exwm--center-float 1200)))) + +(defvar jao-exwm-floating-classes nil) + +(defun jao-exwm--maybe-float () + (when (member exwm-class-name jao-exwm-floating-classes) + (when (not exwm--floating-frame) + (exwm-floating-toggle-floating)))) + +;;;###autoload +(defun jao-exwm-set-up-float-windows (&optional floating-classes) + (setq jao-exwm-floating-classes floating-classes) + (add-hook 'exwm-floating-setup-hook #'jao-exwm--setup-float) + (add-hook 'exwm-manage-finish-hook #'jao-exwm--maybe-float)) + +;;; App runners +(defun jao-exwm-run (command) + (interactive + (list (read-shell-command "$ " + (if current-prefix-arg + (cons (concat " " (buffer-file-name)) 0) + "")))) + (setq jao-exwm--current-name nil) + (start-process-shell-command command nil command)) + +(defmacro jao-exwm-runner (&rest args) + `(lambda () (interactive) (start-process "" nil ,@args))) + +(defun jao-exwm-workspace (n) + (if jao-exwm-use-afio + (jao-afio-goto-nth n) + (exwm-workspace-switch-create n))) + +(defmacro jao-def-exwm-runner (name ws class &rest args) + `(defun ,name (&rest other-args) + (interactive) + ,@(when ws `((jao-exwm-workspace ,ws))) + (if (jao-exwm-switch-to-class/title ,class) + ,(cond ((equal ws -1) '(delete-other-windows)) + ((stringp (car args)) (cdr args)) + (t args)) + (setq jao-exwm--current-name ,class) + ,(if (stringp (car args)) + `(start-process-shell-command ,(car args) + "* exwm - console *" + (string-join (append (list ,@args) + other-args) + " ")) + args)))) + +(defmacro jao-def-exwm-toggler (name ws class &rest args) + (let ((toggler (intern (format "%s*" name))) + (arg (gensym))) + `(progn (jao-def-exwm-runner ,name ,ws ,class ,@args) + (defun ,toggler (,arg) + (interactive "P") + (if (and (not ,arg) (equal exwm-class-name ,class)) + (jao-afio-toggle) + (,name)))))) + +;;; Firefox support +(jao-def-exwm-toggler jao-exwm-firefox -1 "firefox" "firefox") + +(defun jao-exwm-browse-with-firefox (&rest args) + (jao-exwm-firefox) + (apply #'browse-url-firefox args)) + +;;;###autoload +(defun jao-exwm-kill-firefox-url () + (interactive) + (when-let* ((b (jao-exwm-find-class-buffer "firefox"))) + (let ((cb (current-buffer))) + (switch-to-buffer b) + (exwm-input--fake-key ?y) + (exwm-input--fake-key ?y) + (prog1 (message "%s" (current-kill 1)) + (switch-to-buffer cb))))) + +;;;###autoload +(defun jao-exwm-firefox-search (query) + (interactive "sQuery: ") + (jao-exwm-firefox) + (sit-for 0.2) + (exwm-input--fake-key ?S) + (dolist (k (string-to-list query)) + (exwm-input--fake-key k)) + (sit-for 0.2) + (exwm-input--fake-key ?\r)) + +;;; set up +;;;###autoload +(defun jao-exwm-setup (&optional floating-classes) + (jao-exwm-set-up-minibuffer) + (jao-exwm-set-up-buffer-handling) + (jao-exwm-set-up-float-windows floating-classes)) + +(provide 'jao-exwm) +;;; jao-exwm.el ends here diff --git a/lib/eos/jao-wayland.el b/lib/wm/jao-wayland.el index 9458ccb..e743eb0 100644 --- a/lib/eos/jao-wayland.el +++ b/lib/wm/jao-wayland.el @@ -18,6 +18,7 @@ ;; 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 'browse-url) (require 'jao-shell) (require 'jao-pdf) (require 'jao-tracking) diff --git a/lib/wm/jao-x11.el b/lib/wm/jao-x11.el new file mode 100644 index 0000000..788bfe6 --- /dev/null +++ b/lib/wm/jao-x11.el @@ -0,0 +1,75 @@ +;;; jao-x11.el --- keyboard settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 jao + +;; Author: jao <mail@jao.io> + +;; 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-shell) + +;;; Brightness +(jao-shell-def-exec jao-bright-set-up "brightnessctl" "-q" "s" "5%+") +(jao-shell-def-exec jao-bright-set-down "brightnessctl" "-q" "s" "5%-") + +(defun jao-x11-brightness () + (string-trim (or (cadr (jao-shell-cmd-lines "brightnessctl")) "(Unknown)"))) + +;;;###autoload +(defun jao-x11-bright-show () + (interactive) + (message "%s" (jao-x11-brightness))) + +;;;###autoload +(defun jao-x11-bright-up () + (interactive) + (jao-shell-exec "brightnessctl -q s 5%%+" t) + (jao-x11-bright-show)) + +;;;###autoload +(defun jao-x11-bright-down () + (interactive) + (jao-shell-exec "brightnessctl -q s 5%%-" t) + (jao-x11-bright-show)) + +;;; Keyboard +;;;###autoload +(defun jao-x11-kb-layout () + (string-trim + (shell-command-to-string + "setxkbmap -query | grep 'layout:' | awk '{print $2}'"))) + +;;;###autoload +(defun jao-x11-kb-set (lyt &optional intl) + (interactive "sLayout: ") + (let ((intl (if intl " -variant intl" ""))) + (shell-command-to-string (format "setxkbmap %s%s" lyt intl)))) + +;;;###autoload +(defun jao-x11-kb-toggled-p () + (not (string-empty-p + (shell-command-to-string "setxkbmap -query|grep variant")))) + +;;;###autoload +(defun jao-x11-kb-toggle () + (interactive) + (jao-x11-kb-set (jao-x11-kb-layout) (not (jao-x11-kb-toggled-p)))) + +;;;###autoload +(defun jao-x11-kb-disable-laptop () + (interactive) + (jao-shell-exec "xinput float 13")) + +(provide 'jao-x11) +;;; jao-x11.el ends here |