diff options
Diffstat (limited to 'lib')
32 files changed, 1537 insertions, 1940 deletions
diff --git a/lib/doc/jao-doc-session.el b/lib/doc/jao-doc-session.el new file mode 100644 index 0000000..877a8cb --- /dev/null +++ b/lib/doc/jao-doc-session.el @@ -0,0 +1,59 @@ +;;; jao-doc-session.el --- persistent document sessions -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2024 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/>. + +;;; Code: + +(persist-defvar jao-doc-session nil "Documents session") + +(defvar-local jao-doc-session--is-doc nil) + +(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) + +(defun jao-doc-session-save (&optional skip-current force) + "Traverse all current buffers and update the value of `jao-doc-session'." + (interactive) + (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 (or force (> (length docs) 0)) + (setq 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) + (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) + +(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 ea55565..fe26c1d 100644 --- a/lib/doc/jao-doc-view.el +++ b/lib/doc/jao-doc-view.el @@ -1,4 +1,4 @@ -;; jao-doc-view.el -- Remembering visited documents -*- lexical-binding: t; -*- +;;; jao-doc-view.el -- extensions for doc-view -*- lexical-binding: t; -*- ;; Copyright (c) 2013, 2015, 2017, 2018, 2019, 2021, 2022 Jose Antonio Ortega Ruiz @@ -18,162 +18,32 @@ ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Fri Feb 15, 2013 01:21 -;;; Comentary: - -;; Some utilities to keep track of visited documents and their structure. - -;;; Code: - - -;;; Session - (require 'doc-view) +(require 'jao-pdf) -(defvar jao-doc-view-session-file "~/.emacs.d/cache/doc-view-session.eld") -(defvar-local jao-doc-view--is-doc nil) +;;; Utilities -(defun jao-doc-view-session-mark (path) (setq-local jao-doc-view--is-doc path)) -(defun jao-doc-view--is-doc () - (or jao-doc-view--is-doc - (when (derived-mode-p 'doc-view-mode 'pdf-view-mode 'nov-mode) - (buffer-file-name)))) - -(defun jao-doc-view--read-file (file) - (let ((buff (find-file-noselect file))) - (ignore-errors - (with-current-buffer buff - (goto-char (point-min))) - (read buff)))) - -(defun jao-doc-view--save-to-file (file value) - (with-current-buffer (find-file-noselect file) - (erase-buffer) - (insert (format "%S" value)) - (save-buffer))) - -(defun jao-doc-view-session (&optional file) - (let ((file (or file jao-doc-view-session-file))) - (jao-doc-view--read-file file))) - -(defun jao-doc-view-save-session (&optional skip-current) - (interactive) - (let ((docs '()) - (cb (when skip-current (current-buffer)))) - (dolist (b (buffer-list)) - (with-current-buffer b - (when-let (fn (and (not (eq cb b)) (jao-doc-view--is-doc))) - (add-to-list 'docs fn)))) - (when (> (length docs) 0) - (jao-doc-view--save-to-file jao-doc-view-session-file docs)))) - -(defun jao-doc-view--save-session-1 () - (when (jao-doc-view--is-doc) (jao-doc-view-save-session t))) - -(defvar jao-doc-view-inhibit-session-save nil) - -(defun jao-doc-view--save-session () - (let ((inhibit-message t) - (message-log-max nil)) - (when (not jao-doc-view-inhibit-session-save) - (jao-doc-view-save-session)) - t)) - -(add-hook 'kill-emacs-query-functions #'jao-doc-view--save-session) -(add-hook 'kill-buffer-hook #'jao-doc-view--save-session-1) -(add-hook 'doc-view-mode-hook #'jao-doc-view--save-session) -(add-hook 'pdf-view-mode-hook #'jao-doc-view--save-session) -(add-hook 'nov-mode-hook #'jao-doc-view--save-session) - - -;;; PDF info - -(defvar-local jao--pdf-outline nil) - -(defmacro jao-doc-view--pdf-call (a b &rest args) +(defmacro jao-doc-view--funcall (a b &rest args) `(cond ((derived-mode-p 'pdf-view-mode) (,a ,@args)) ((derived-mode-p 'doc-view-mode) (,b ,@args)))) -(defun jao-doc-view-is-pdf (file) (string-match-p ".*\\.pdf$" file)) - -(defun jao-doc-view-title->file (title) - (concat (mapconcat 'downcase (split-string title nil t) "-") ".pdf")) - (defun jao-doc-view-current-page () - (jao-doc-view--pdf-call pdf-view-current-page doc-view-current-page)) + (jao-doc-view--funcall pdf-view-current-page doc-view-current-page)) (defun jao-doc-view-goto-page (page &optional height) (when page - (jao-doc-view--pdf-call pdf-view-goto-page doc-view-goto-page page)) + (jao-doc-view--funcall pdf-view-goto-page doc-view-goto-page page)) (when (and height (derived-mode-p 'pdf-view-mode)) (image-set-window-vscroll (round (/ (* height (cdr (pdf-view-image-size))) (frame-char-height)))))) -(defun jao-doc-view-pdf-outline (&optional file-name) - (if (derived-mode-p 'pdf-view-mode) - (pdf-info-outline) - (let* ((outline nil) - (fn (or file-name (buffer-file-name) jao-doc-view--imenu-file)) - (fn (shell-quote-argument (expand-file-name fn)))) - (with-temp-buffer - (insert (shell-command-to-string (format "mutool show %s outline" fn))) - (goto-char (point-min)) - (while (re-search-forward ".+\\(\t+\\)\"\\(.+\\)\"\t#\\([0-9]+\\)," nil t) - (push `((level . ,(length (match-string 1))) - (title . ,(match-string 2)) - (page . ,(string-to-number (match-string 3)))) - outline))) - (nreverse outline)))) - -(defun jao-doc-view-section-title (&optional page file-name) - (when (not jao--pdf-outline) - (setq-local jao--pdf-outline (jao-doc-view-pdf-outline file-name))) - (let ((page (or page (jao-doc-view-current-page))) - (outline jao--pdf-outline) - (cur-page 0) - (cur-title (jao-doc-view-title (or file-name buffer-file-name "title")))) - (while (and (car outline) (< cur-page page)) - (setq cur-page (cdr (assoc 'page (car outline)))) - (when (<= cur-page page) - (setq cur-title (cdr (assoc 'title (car outline))))) - (setq outline (cdr outline))) - (replace-regexp-in-string "[[:blank:]]+" " " cur-title))) - -(defun jao-doc-view-title (&optional fname) - (if (or fname (not (derived-mode-p 'doc-view-mode 'pdf-view-mode))) - (let ((base (file-name-base (or fname (buffer-file-name))))) - (capitalize (replace-regexp-in-string "-" " " base))) - (or (jao-doc-view-section-title) - (when buffer-file-name (jao-doc-view-title buffer-file-name))))) - - ;;; imenu -(defvar-local jao-doc-view--imenu-file nil) -(defvar-local jao-doc-view--goer 'jao-doc-view-goto-page) - -(defun jao-doc-view--enable-imenu (&optional file-name goto-page) - (setq-local imenu-create-index-function #'jao-doc-view--imenu-create-index - jao-doc-view--imenu-file (or file-name jao-doc-view--imenu-file) - jao-doc-view--goer (or goto-page 'jao-doc-view-goto-page)) - (imenu-add-to-menubar "PDF outline")) - -(defun jao-doc-view--imenu-create-index () - (let (index) - (dolist (item (or jao--pdf-outline - (setq jao--pdf-outline - (jao-doc-view-pdf-outline jao-doc-view--imenu-file)))) - (let-alist item - (let* ((lvl (make-string (max 0 (1- .level)) ?.)) - (title (format "%s%s (%s)" lvl .title .page))) - (push `(,title 0 jao-doc-view--go ,item) index)))) - (nreverse index))) - -(defun jao-doc-view--go (&rest args) - (when-let (item (car (last args))) - (let-alist item (funcall jao-doc-view--goer .page)))) - -(add-hook 'doc-view-mode-hook #'jao-doc-view--enable-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)) + (doc-view-imenu-setup) + (setq-local imenu-create-index-function ifun))) + ;;; Page trailing (defvar-local jao-doc-view--trail-back ()) (defvar-local jao-doc-view--trail-fwd ()) @@ -199,38 +69,55 @@ (advice-add 'doc-view-goto-page :before #'jao-doc-view--trail-push) - +;;; Extract text +(defun jao-doc-view-page-text (&optional re-render no-select) + (interactive "P") + (let* ((pno (doc-view-current-page)) + (in buffer-file-name) + (cdir (or (doc-view--current-cache-dir) "/tmp")) + (out (format "%s/p%s.txt" cdir pno))) + (when (and (file-exists-p out) re-render) + (delete-file out)) + (unless (file-exists-p out) + (shell-command-to-string (format "mutool convert -o %s %s %s" out in pno))) + (if no-select + out + (find-file out) + (view-mode)))) + +(define-key doc-view-mode-map "t" #'jao-doc-view-page-text) + ;;; Find URLs -(defun jao-doc-view--page-urls (all) - (if doc-view--current-converter-processes - (message "DocView: please wait till conversion finished.") - (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir))) - (page (doc-view-current-page)) - (pd-rx (rx (+ (literal page-delimiter)))) - (urls)) - (if (file-readable-p txt) - (with-current-buffer (find-file-noselect txt) - (goto-char (point-min)) - (unless all (re-search-forward pd-rx nil t (1- page))) - (let ((end (save-excursion - (if (and (not all) (re-search-forward pd-rx nil t)) - (point) - (point-max))))) - (while (re-search-forward "https?://" end t) - (push (thing-at-point-url-at-point) urls)) - urls)) - (doc-view-doc->txt txt (lambda () (jao-doc-view--page-urls all))) - 'wait)))) +(defun jao-doc-view--full-txt () + (expand-file-name "doc.txt" (doc-view--current-cache-dir))) + +(defun jao-doc-view--collect-urls (file) + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (let ((urls nil)) + (while (re-search-forward "https?://" nil t) + (push (thing-at-point-url-at-point) urls)) + urls))) + +(defun jao-doc-view--page-urls (&optional all) + (let ((txt (jao-doc-view--full-txt))) + (cond ((and all (not (file-exists-p txt))) + (message "Full text not extracted yet: doing so!") + (doc-view-doc->txt txt (lambda () (message "Text extracted"))) + 'wait) + (all (jao-doc-view--collect-urls txt)) + (t (jao-doc-view--collect-urls (jao-doc-view-page-text nil t)))))) (defun jao-doc-view-visit-url (all) "Visit URL displayed in this page." - (interactive "P" doc-view-mode) + (interactive "P") (let ((urls (jao-doc-view--page-urls all))) (cond ((eq 'wait urls) (message "Extracting text, please wait and retry.")) - ((zerop (length urls)) (message "No URLs in this page")) + ((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)))) (browse-url url)))))) - +;;; . (provide 'jao-doc-view) diff --git a/lib/doc/jao-org-links.el b/lib/doc/jao-org-links.el index 9102927..88c0561 100644 --- a/lib/doc/jao-org-links.el +++ b/lib/doc/jao-org-links.el @@ -1,21 +1,20 @@ ;; -*- lexical-binding: t; -*- -(require 'pdf-tools nil t) - (require 'jao-org-notes) (require 'jao-doc-view) - -(declare pdf-info-outline "pdf-info") +(require 'jao-doc-session) +(require 'jao-pdf) (defvar jao-org--sink-dir "./") -(defvar jao-org-open-pdf-fun #'jao-org--pdf-tools-open) +(defvar jao-org-open-pdf-fun #'jao-org--default-open) -(defun jao-org--pdf-tools-open (path page &optional height) +(defun jao-org--default-open (path page &optional height) (org-open-file path 1) (jao-doc-view-goto-page page height)) (defun jao-org--pdf-open (path page &optional height) - (funcall (or jao-org-open-pdf-fun #'jao-org--pdf-tools-open) path page height)) + (when (file-exists-p path) (jao-doc-session-mark path)) + (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." @@ -39,7 +38,7 @@ (read-file-name "Import file: " jao-org--sink-dir link link)))) (rename-file real-file dest-path))) - (if (jao-doc-view-is-pdf dest-path) + (if (jao-pdf-is-pdf-file dest-path) (jao-org-links--open-pdf full-link) (browse-url (format "file://%s" (expand-file-name dest-path)))))) @@ -47,7 +46,7 @@ (let ((default-directory jao-org--sink-dir)) (let ((f (replace-regexp-in-string "^file:" "doc:" (org-file-complete-link arg)))) - (if (jao-doc-view-is-pdf f) + (if (jao-pdf-is-pdf-file f) (let ((page (read-from-minibuffer "Page: " ""))) (if (> (string-to-number page) 0) (concat f "::" (read-from-minibuffer "Page: " "")) @@ -63,7 +62,7 @@ (when (derived-mode-p 'pdf-view-mode 'doc-view-mode) (jao-org-links-store-pdf-link buffer-file-name (jao-doc-view-current-page) - (jao-doc-view-section-title))))) + (jao-pdf-section-title))))) ;;;###autoload (defun jao-org-links-store-pdf-link (path page title) @@ -75,29 +74,28 @@ ;;;###autoload (defun jao-org-insert-doc (title) (interactive "sDocument title: ") - (insert (format "[[doc:%s][%s]]" (jao-doc-view-title->file title) title))) + (insert (format "[[doc:%s][%s]]" (jao-pdf-title-to-file-name title) title))) ;;;###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-pdf-to-org-file (&optional file-name) - (let* ((file-name (or file-name buffer-file-name)) - (bn (file-name-base file-name)) - (rx (format "%s\\.org$" (regexp-quote bn)))) - (save-some-buffers nil - (lambda () - (string-prefix-p jao-org-notes-dir buffer-file-name))) - (or (car (directory-files-recursively jao-org-notes-dir rx)) - (let* ((dirs (jao-org-notes-cats)) - (dir (completing-read "Notes subdir: " dirs nil t))) - (expand-file-name (concat dir "/" bn ".org") jao-org-notes-dir))))) +(defun jao-org-open-from-zathura (title &optional no-ask) + (when-let* ((info (jao-pdf-zathura-file-info title)) + (pdf-file (car info)) + (page (cadr info)) + (file (jao-org-notes-find-for-pdf pdf-file))) + (jao-afio-goto-docs) + (let ((exists (file-exists-p file))) + (find-file file) + (unless exists (jao-org-insert-doc-skeleton)) + (let ((lnk (jao-pdf--zathura-link info))) + (jao-doc-session-mark) + (if (or (not exists) (and (not no-ask) (y-or-n-p "Insert link?"))) + (insert lnk "\n") + (kill-new lnk) + (message "Link to %s (%s) killed" file page)))))) ;;;###autoload (defun jao-org-insert-doc-skeleton (&optional title) - (insert "#+title: " (or title (jao-doc-view-title (buffer-file-name))) + (insert "#+title: " (or title (jao-pdf-title (buffer-file-name))) "\n#+author:\n#+filetags: ") (jao-org-notes-insert-tags) (insert "\n#+startup: latexpreview\n\n")) @@ -105,10 +103,10 @@ ;;;###autoload (defun jao-org-pdf-goto-org (arg) (interactive "P") - (when (jao-doc-view-is-pdf buffer-file-name) - (let* ((file (jao-org-pdf-to-org-file)) + (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-doc-view-title))) + (title (jao-pdf-title))) (when (or arg new) (org-store-link nil t)) (find-file-other-window file) (when new @@ -119,12 +117,15 @@ (defun jao-org-pdf-goto-org* () (interactive) (jao-org-pdf-goto-org t)) ;;;###autoload -(defun jao-org-org-goto-pdf () +(defun jao-org-goto-pdf () (interactive) (if-let (f (jao-org-org-to-pdf-file)) - (find-file-other-window f) + (jao-org--pdf-open f nil) (user-error "No PDF file associated with this buffer"))) +(with-eval-after-load "org" + (define-key org-mode-map (kbd "C-c o") #'jao-org-goto-pdf)) + ;;;###autoload (defun jao-org-links-setup (sink-dir) (interactive) @@ -133,7 +134,6 @@ :complete #'jao-org-links--complete-doc :store #'jao-org-links--store-pdf-link) (org-link-set-parameters "docview" :store #'ignore) - (org-link-set-parameters "message" :follow #'jao-org-links-open-mail) (setq jao-org--sink-dir (file-name-as-directory sink-dir))) (provide 'jao-org-links) diff --git a/lib/doc/jao-org-notes.el b/lib/doc/jao-org-notes.el index 738c938..bd82543 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 jao +;; Copyright (C) 2020, 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: tools @@ -26,36 +26,64 @@ ;;; Code: (require 'org) (require 'consult) +(require 'jao-shell) (defvar jao-org-notes-dir (expand-file-name "notes" org-directory)) -(defun jao-org-notes--rg (str) +(defun jao-org-notes-list () + (directory-files-recursively jao-org-notes-dir "\\.org$")) + +(defun jao-org-notes--rg-cmd (rgx &rest args) `("rg" "--null" "--line-buffered" "--color=never" "--max-columns=250" - "--no-heading" "--line-number" "--smart-case" "." "-e" - ,(format "^(#.(title|filetags): .*)%s" str))) + "--type=org" "--line-number" "--no-heading" "--smart-case" + ,@args ,default-directory "-e" ,rgx)) + +(defun jao-org-notes--rg-title-or-tags (str) + (let* ((m (string-match "^\\([^/]+\\)/\\(.*\\)" str)) + (d (or (and m (match-string 1 str)) "")) + (str (if m (match-string 2 str) str)) + (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))) + (jao-org-notes--rg-cmd rgx "-m" "2"))) (defun jao-org-notes--clean-match (m) - (cons (format "%s %s" - (replace-regexp-in-string "^\\./" "" (car m)) - (replace-regexp-in-string "[0-9]+:#\\+\\(file\\)?\\(title\\|tags\\):" - " (\\2)" (cadr m))) - (expand-file-name (car m) default-directory))) + (list (format "%s %s" + (replace-regexp-in-string default-directory "" (car m) nil t) + (replace-regexp-in-string "[0-9]+:#\\+\\(title\\|tags\\):" + "" (cadr m))) + (expand-file-name (car m) default-directory) + (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)) +(defun jao-org-notes--grep-rx (rx &rest rg-args) + (let ((default-directory jao-org-notes-dir)) + (jao-org-notes--matches + (apply #'jao-shell-cmd-lines (apply #'jao-org-notes--rg-cmd rx rg-args))))) + (defvar jao-org-notes--grep-history nil) -(defun jao-org--grep (prompt &optional cat no-req) +(defun jao-org-notes--consult-group (m transform) + (or (and transform m) + (and (string-match-p "^[^:]+ + :" m) "tags") + "titles")) + +(defun jao-org-notes--consult-rg (prompt &optional cat no-req cmd) (let ((default-directory (expand-file-name (or cat "") jao-org-notes-dir))) (consult--read - (consult--async-command #'jao-org-notes--rg + (consult--async-command #'jao-org-notes--rg-title-or-tags (consult--async-transform jao-org-notes--matches)) :prompt prompt :initial (consult--async-split-initial "") :add-history (concat (consult--async-split-initial (thing-at-point 'symbol))) :require-match (not no-req) :category 'jao-org-notes-lookup + :group 'jao-org-notes--consult-group + :lookup (lambda (cand cands &rest _) + (or (cadr (assoc cand cands)) (substring cand 1))) :history '(:input jao-org-notes--grep-history)))) (defun jao-org-notes-cats () @@ -64,15 +92,15 @@ (defun jao-org-notes--cat () (let* ((cat (completing-read "Top level category: " (jao-org-notes-cats)))) (cond ((file-exists-p (expand-file-name cat jao-org-notes-dir)) cat) - ((yes-or-no-p "New category, create?") cat) - (t (jao-roam--cat))))) + ((yes-or-no-p "New category, create?") cat)))) (defun jao-org-notes--insert-title () (let* ((cat (jao-org-notes--cat)) - (title (file-name-base (jao-org--grep "Title: " cat t))) + (title (file-name-base (jao-org-notes--consult-rg "Title: " cat t))) (title (replace-regexp-in-string "^#" "" title))) (when (not (string-empty-p title)) (let* ((base (replace-regexp-in-string " +" "-" (downcase title))) + (base (replace-regexp-in-string "[^-[:alnum:][:digit:]]" "" base)) (fname (expand-file-name (concat cat "/" base ".org") jao-org-notes-dir)) (exists? (file-exists-p fname))) @@ -81,85 +109,88 @@ (insert "#+title: " title "\n") t))))) -(defvar jao-org-notes--tags nil) -(defvar jao-org-notes-tags-cache-file "~/.emacs.d/cache/tags.eld") - -(defun jao-org-notes--save-tags () - (with-current-buffer (find-file-noselect jao-org-notes-tags-cache-file) - (delete-region (point-min) (point-max)) - (print jao-org-notes--tags (current-buffer)) - (let ((message-log-max nil) - (inhibit-message t)) - (save-buffer)))) +(defun jao-org-notes--find-tag (tag) + (jao-org-notes--grep-rx (format "^#.tags:.*:%s:" tag) "-m" "1")) -(defun jao-org-notes--read-tags-cache () - (let ((b (find-file-noselect jao-org-notes-tags-cache-file))) - (with-current-buffer b (goto-char (point-min))) - (setq jao-org-notes--tags (read b)))) +(defvar jao-org-notes--tags nil) +(defvar jao-org-notes--tag-history nil) (defun jao-org-notes--read-tags () - (unless jao-org-notes--tags (jao-org-notes--read-tags-cache)) - (let* ((tags (completing-read-multiple "Tags: " jao-org-notes--tags)) - (new-tags (seq-difference tags jao-org-notes--tags))) - (when new-tags - (setq jao-org--notes-tags - (sort (append new-tags jao-org-notes--tags) #'string<)) - (jao-org-notes--save-tags)) + (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)) -(defun jao-org-notes--insert-tags () - (insert "#+filetags: " (mapconcat #'identity (jao-org-notes--read-tags) " ") "\n")) - -(defun jao-org-notes--insert-date () - (insert "#+date: ") - (org-insert-time-stamp (current-time)) - (insert "\n")) - (defun jao-org-notes--template (k) - `(,k "Note" plain (file jao-org-notes-open-or-create) - "\n- %a\n %i" - :jump-to-captured t)) + `(,k "Note" plain (file jao-org-notes-create) + "%(if %:url \"#+link: %:url\" \"\")\n\n- %a\n %i")) + +(defun jao-org-notes-all-tags () + (let ((tags nil)) + (dolist (m (jao-org-notes--find-tag ".*")) + (setq tags (seq-union tags (cdr (split-string (car m) ":" t))))) + (sort tags #'string<))) + +(defun jao-org-notes-find-for-pdf (&optional file-name) + "Given a PDF file name, find its org notes counterpart." + (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)))) + (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." (interactive) - (when-let (f (jao-org--grep "Search notes: ")) + (when-let (f (jao-org-notes--consult-rg "Search notes: ")) (find-file f))) -;;;###autoload -(defun jao-org-notes-open-or-create () - "Open or create a new note file, matching tags and titles with completion." +(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)) + +(defun jao-org-notes-create () + "Create a new note file, matching tags and titles with completion." (interactive) (when (jao-org-notes--insert-title) - (jao-org-notes--insert-date) - (jao-org-notes--insert-tags)) + (org-insert-time-stamp (current-time) t t "#+date: " "\n") + (insert "#+tags: :" + (mapconcat #'identity (jao-org-notes--read-tags) ":") + ":\n")) (save-buffer) (buffer-file-name)) -;;;###autoload -(defun jao-org-notes-grep (&optional initial) - "Perform a grep search on all org notes body, via consult-ripgrep." - (interactive) - (consult-ripgrep jao-org-notes-dir initial)) - -;;;###autoload (defun jao-org-notes-backlinks () "Show a list of note files linking to the current one." (interactive) - (jao-org-notes-search (concat "\\[\\[file:\\(.*/\\)?" (buffer-name)))) + (if-let* ((res (jao-org-notes--grep-rx + (concat "\\[file:.*" (regexp-quote (buffer-name)) "\\]\\["))) + (file (completing-read "File: " res nil t nil)) + (entry (assoc file res))) + (progn (find-file (cadr entry)) + (when-let (line (caddr entry)) (goto-line line))) + (message "Nobody links here!"))) -;;;###autoload (defun jao-org-notes-insert-tags () "Insert a list of tags at point, with completing read." (interactive) - (insert (mapconcat 'identity (jao-org-notes--read-tags) " "))) + (insert ":" (mapconcat 'identity (jao-org-notes--read-tags) ":") ":")) -;;;###autoload (defun jao-org-notes-insert-link () "Select a note file (with completion) and insert a link to it." (interactive) - (when-let (f (jao-org--grep "Notes file: ")) + (when-let (f (jao-org-notes--consult-rg "Notes file: ")) (let ((rel-path (file-relative-name f default-directory)) (title (with-current-buffer (find-file-noselect f) (save-excursion @@ -168,11 +199,19 @@ (match-string 1)))))) (insert (format "[[file:%s][%s]]" rel-path title))))) +(defun jao-org-notes-stats () + (interactive) + (message "%d notes, %d tags in %s" + (length (jao-org-notes-list)) + (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))) + (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic)) + 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 new file mode 100644 index 0000000..1ee74bc --- /dev/null +++ b/lib/doc/jao-pdf.el @@ -0,0 +1,100 @@ +;;; jao-pdf.el --- utilities for pdf files -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 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/>. + +;;; Commentary: + +;; Some niceties for PDFs: +;; +;; - Using mutools, we can extract the outline of PDFs, and tell back the +;; section title of a given page. +;; - Interoperability with zathura. + +(require 'jao-doc-session) + +;;; PDF info + +(declare-function 'pdf-info-outline "pdf-info") + +(defvar-local jao-pdf--outline nil) + +(defun jao-pdf-is-pdf-file (file) + "Simply checks the FILE extension." + (string-match-p ".*\\.pdf$" file)) + +(defun jao-pdf-title-to-file-name (title) + "Convert a title, possibly with embedded spaces, to a PDF filename." + (concat (mapconcat 'downcase (split-string title nil t) "-") ".pdf")) + +(defun jao-pdf-title (&optional fname) + (if (or fname (not (derived-mode-p 'doc-view-mode 'pdf-view-mode))) + (let ((base (file-name-base (or fname (buffer-file-name))))) + (capitalize (replace-regexp-in-string "-" " " base))) + (or (jao-pdf-section-title) + (when buffer-file-name (jao-pdf-title buffer-file-name))))) + +(defvar-local jao-pdf--outline nil) + +(defun jao-pdf-section-title (&optional page file-name) + (when (not jao-pdf--outline) + (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)))) + (outline jao-pdf--outline) + (cur-page 0) + (cur-title (jao-pdf-title (or file-name buffer-file-name "title")))) + (while (and (car outline) page (< cur-page page)) + (setq cur-page (cdr (assoc 'page (car outline)))) + (when (<= cur-page page) + (setq cur-title (cdr (assoc 'title (car outline))))) + (setq outline (cdr outline))) + (replace-regexp-in-string "[[:blank:]]+" " " cur-title))) + +;;; zathura interop +(defun jao-pdf-zathura-open-cmd (file page &optional suffix) + (let ((page (if page (format "-P %s" page) ""))) + (format "zathura %s %s %s" file page (or suffix "")))) + +(defun jao-pdf-zathura-title-rx (file) + (concat (file-name-nondirectory file) " \\[.+\\]")) + +;; e.g. "~/org/doc/write-yourself-a-scheme-in-48-hours.pdf [96 (96/138)]" +(defun jao-pdf-zathura-file-info (title) + (when (string-match "\\(.+\\) \\[\\(.+\\) (\\([0-9]+\\)/\\([0-9]+\\))\\]" + title) + (list (expand-file-name (match-string 1 title)) + (string-to-number (match-string 3 title)) + (string-to-number (match-string 4 title)) + (match-string 2 title)))) + +(defun jao-pdf--zathura-link (info) + (when-let* ((file (car info)) + (page (cadr info)) + (no (or (car (last info)) page)) + (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))) + +(defun jao-pdf-zathura-org-link (title) + (jao-pdf--zathura-link (jao-pdf-zathura-file-info title))) + +(provide 'jao-pdf) +;;; jao-pdf.el ends here diff --git a/lib/doc/jao-recoll.el b/lib/doc/jao-recoll.el deleted file mode 100644 index f43451f..0000000 --- a/lib/doc/jao-recoll.el +++ /dev/null @@ -1,116 +0,0 @@ -;; jao-recoll.el -- Displaying recoll queries - -;; Copyright (c) 2017, 2020, 2021, 2022 Jose Antonio Ortega Ruiz - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> -;; Start date: Wed Nov 01, 2017 18:14 - - -;;; Comentary: - -;; A simple interactive command to perform recoll queries and display -;; its results using org-mode. - -;;; Code: - - -(require 'org) - -(define-derived-mode recoll-mode org-mode "Recoll" - "Simple mode for showing recoll query results" - (read-only-mode 1)) - -(defvar jao-recoll--file-regexp - "\\(\\w+/.+\\)\t+\\[\\([^]]+\\)\\]\t+\\[\\([^]]+\\)\\].+") - -(defvar jao-recoll-flags "-A -p 5 -n 100") - -(defvar jao-recoll-single-buffer t) -(defvar-local jao-recoll--last-query nil) -(defvar-local jao-recoll--last-full-query nil) - -(defun jao-recoll-show-query () - (interactive) - (message (concat jao-recoll--last-query "\n" - jao-recoll--last-full-query))) - -(defun jao-recoll-requery () - (interactive) - (jao-recoll jao-recoll--last-query)) - -(defun jao-recoll--buffer (q) - (get-buffer-create (if jao-recoll-single-buffer - "*Recoll*" - (format "*Recoll: '%s'*" q)))) - -;;;###autoload -(defun jao-recoll (&optional prefix-query) - "Performs a query using recoll and shows the results in a buffer -using org mode." - (interactive) - (let* ((query (read-string "Recoll query: " prefix-query)) - (cmd (format "recoll %s -t %s" - jao-recoll-flags (shell-quote-argument query))) - (inhibit-read-only t) - (lnk nil)) - (with-current-buffer (jao-recoll--buffer query) - (recoll-mode) - (delete-region (point-min) (point-max)) - (shell-command cmd t) - (setq jao-recoll--last-query query) - (goto-char (point-min)) - (when (looking-at-p "Recoll query:") - (setq jao-recoll--last-full-query - (string-trim (thing-at-point 'line))) - (let ((kill-whole-line nil)) (kill-line)) - (insert query) - (forward-line 2)) - (open-line 1) - (while (search-forward-regexp jao-recoll--file-regexp nil t) - (setq lnk - (cond ((string= (match-string 1) "application/pdf") - (concat "doc:" - (file-name-nondirectory (match-string 2)))) - ((string= (match-string 1) "message/rfc822") - (concat "message:" (substring (match-string 2) 7))) - (t (match-string 2)))) - (replace-match (format "* [[%s][\\3]] (\\1)" lnk)) - (forward-line) - (when (looking-at-p "SNIPPETS") - (let ((kill-whole-line t)) - (kill-line) - (while (and (not (eobp)) (not (looking-at-p "/SNIPPETS"))) - (if (looking-at "^\\([1-9][0-9]*\\) : ") - (replace-match (format " - [[%s::\\1][\\1]] : " lnk)) - (insert " - ")) - (forward-line 1)) - (unless (eobp) (kill-line))))) - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (org-next-visible-heading 1) - (org-overview) - (jao-recoll-show-query)))) - -(define-key recoll-mode-map [?n] 'org-next-link) -(define-key recoll-mode-map [?p] 'org-previous-link) -(define-key recoll-mode-map [?q] 'bury-buffer) -(define-key recoll-mode-map [?r] 'jao-recoll-requery) -(define-key recoll-mode-map [?g] 'jao-recoll-requery) -(define-key recoll-mode-map [?w] 'jao-recoll-show-query) - - -(provide 'jao-recoll) -;;; jao-recoll.el ends here diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el index 306a1d5..b588989 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 jao +;; Copyright (C) 2020, 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: frames @@ -18,66 +18,63 @@ ;; 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: - +;;; initialisation (require 'cl-lib) +(require 'jao-doc-session) + +(defvar jao-afio-use-frames (not window-system)) (defvar jao-open-doc-fun 'find-file) (defvar jao-afio-mail-function 'gnus) (defvar jao-afio-use-w3m nil) -(defvar jao-afio-notmuch-in-web nil) +(defvar jao-afio-auto-toggle nil) (defvar jao-afio-switch-hook nil) -(defvar jao-afio--configs '(?c ?w ?g ?p ?s)) -(defvar jao-afio--current-config (car jao-afio--configs)) -(defvar jao-afio--locker nil) -(defvar jao-afio-fallback-fun nil) +(defvar jao-afio--configs '(?c ?w ?g ?p ?s ?t)) +(defvar jao-afio--previous-config (car jao-afio--configs)) -(defun jao-afio--check-frame-p () - (assoc 'afio (frame-parameters))) +(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) (interactive) - (when (and (frame-live-p jao-afio--locker) - (not (eql f jao-afio--locker))) - (if jao-afio-fallback-fun - (funcall jao-afio-fallback-fun) - (error "Another frame is using afio"))) - (setq jao-afio--locker f) - (modify-frame-parameters f '((afio . t))) - (setq jao-afio--current-config ?c) - (mapc (lambda (r) (set-register r nil)) jao-afio--configs) - (window-configuration-to-register ?c)) - -(defun jao-afio--steal () - (interactive) - (setq jao-afio--locker nil) - (jao-afio--init (window-frame (get-buffer-window (current-buffer))))) + (jao-afio--current-config ?c) + (if jao-afio-use-frames + (set-frame-name "W1") + (window-configuration-to-register ?c))) (defun jao-afio--check-frame () - (unless (jao-afio--check-frame-p) - (or ;; (when jao-afio-fallback-fun - ;; (funcall jao-afio-fallback-fun) - ;; t) - (when (y-or-n-p "Another frame is using afio. Steal? ") - (jao-afio--steal) - t) - (error "Aborted")))) - -(defun jao-afio--next-frame () - (interactive) - (jao-afio--check-frame) - (let* ((cur (member jao-afio--current-config jao-afio--configs)) - (next (or (cadr cur) (car jao-afio--configs)))) - (jao-afio--goto-frame next))) + (unless (jao-afio--current-config) + (jao-afio--init (window-frame (get-buffer-window (current-buffer)))))) +;;; utilities +(defun jao-afio-trisect (&optional force) + (interactive) + (let ((fw (frame-width)) + (display-buffer-alist nil)) + (cond ((or force (>= fw 240)) + (let ((b (current-buffer))) + (delete-other-windows) + (switch-to-buffer (other-buffer b)) + (split-window-horizontally) + (switch-to-buffer (other-buffer b)) + (split-window-horizontally) + (switch-to-buffer b) + (balance-windows))) + ((> fw 162) + (delete-other-windows) + (split-window-horizontally) + (switch-to-buffer (other-buffer)))))) + +;;; session openers ;;;###autoload -(defun jao-afio-open-pdf-session () +(defun jao-afio-open-pdf-session (&optional docs) (interactive) - (let ((jao-doc-view-inhibit-session-save t)) - (dolist (doc (jao-doc-view-session)) - (when (and (file-exists-p doc) (y-or-n-p (format "Open %s? " doc))) - (jao-open-doc doc) + (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))) @@ -85,43 +82,48 @@ (interactive) (delete-other-windows) (split-window-right) - (let ((docs (cl-remove-if-not (lambda (b) - (with-current-buffer b (jao-doc-view--is-doc))) - (buffer-list)))) + (let ((docs (cl-remove-if-not 'jao-doc-session-is-doc (buffer-list)))) (if (car docs) (progn (switch-to-buffer (car docs)) (switch-to-buffer-other-window (or (cadr docs) (car docs)))) - (when (and (jao-doc-view-session) (y-or-n-p "Load saved session? ")) - (jao-afio-open-pdf-session))))) + (when-let (docs (jao-doc-session)) + (when (y-or-n-p (format "Load saved session? (%d docs)" (length docs))) + (jao-afio-open-pdf-session docs)))))) + +(declare-function w3m "w3m") +(declare-function notmuch "notmuch") +(declare-function jao-eww-session-eww-buffers "jao-eww-session") +(declare-function jao-eww-session-load "jao-eww-session") -(declare w3m "w3m") -(declare w3m-alive-p "w3m") -(declare w3m-previous-buffer "w3m") -(declare notmuch "notmuch") +(defun jao-afio--open-eww-session () + (if-let (b (jao-eww-session-eww-buffers)) + (switch-to-buffer (car b)) + (jao-eww-session-load))) ;;;###autoload (defun jao-afio-open-www () (interactive) (require 'jao-eww-session) (if (< (frame-width) 160) - (if jao-afio-use-w3m (w3m) (jao-eww-session-load)) - (delete-other-windows) - (split-window-right) + (if jao-afio-use-w3m (w3m) (jao-afio--open-eww-session)) (if jao-afio-use-w3m - (w3m) - (jao-eww-session-load) + (progn (delete-other-windows) + (split-window-right) + (w3m)) + (jao-afio-trisect) + (jao-afio--open-eww-session) (let ((b (current-buffer))) (other-window 1) - (if jao-afio-notmuch-in-web - (notmuch) - (switch-to-buffer (car (jao-eww-session--list-buffers b)))) + (switch-to-buffer (car (jao-eww-session-eww-buffers b))) + (other-window 1) + (switch-to-buffer (car (jao-eww-session-eww-buffers b))) (other-window 1))))) ;;;###autoload (defun jao-afio-open-gnus () (interactive) (delete-other-windows) - (org-agenda-list) + (jao-org-agenda) (calendar) (find-file (expand-file-name "inbox.org" org-directory)) (gnus) @@ -131,136 +133,130 @@ (other-window 1) (delete-other-windows-vertically) (find-file (expand-file-name "inbox.org" org-directory)) + (set-window-dedicated-p nil t) (split-window-below (/ (window-height) 3)) (other-window 1) - (org-agenda-list) - (split-window-below -9) + (jao-org-agenda) + (set-window-dedicated-p nil t) + (split-window-below -8) (other-window 1) (switch-to-buffer "*Calendar*") + (set-window-dedicated-p nil t) (other-window 1)) -;;;###autoload -(defun jao-afio-open-notmuch () - (interactive) +(defun jao-afio--open-mail (fun) + (unless (get-buffer "*Calendar*") (calendar)) (delete-other-windows) (split-window-horizontally -80) - (notmuch) - (jao-afio--mail-sidebar)) - -(defun jao-afio-open-mail-function () - (interactive) - (jao-trisect) - (other-window 2) - (delete-window) - (other-window 1) - (funcall jao-afio-mail-function) + (funcall fun) + ;; (set-window-dedicated-p nil t) (jao-afio--mail-sidebar)) ;;;###autoload (defun jao-afio-open-mail () (interactive) - (unless (get-buffer "*Calendar*") (calendar)) (cond ((eq 'gnus jao-afio-mail-function) (jao-afio-open-gnus)) - ((eq 'notmuch jao-afio-mail-function) (jao-afio-open-notmuch)) - (jao-afio-open-mail-function (jao-afio-open-mail-function)))) + ((eq 'notmuch jao-afio-mail-function) (jao-afio--open-mail 'notmuch)) + (t (jao-afio-trisect)))) + +;;;###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)))) + +;;; 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")))) + +(defun jao-afio-frame-no (&optional c) + (alist-get (or c (jao-afio--current-config)) + '((?s . 0) (?c . 1) (?g . 2) (?w . 3) (?p . 4) (?t . 5)))) (defun jao-afio--goto-frame (next &optional reset) - (when (or reset (not (eq next jao-afio--current-config))) - (let ((next-cfg (when (not reset) (get-register next)))) - (window-configuration-to-register jao-afio--current-config) - (setq jao-afio--current-config next) - (if next-cfg - (jump-to-register next) - (delete-other-windows) - (cl-case next - (?w (jao-afio-open-www)) - (?g (jao-afio-open-mail)) - (?p (jao-afio-open-doc)) - (?s (delete-other-windows)))) - (run-hooks 'jao-afio-switch-hook)))) - -(defun jao-afio--goto-main (&optional reset) - (interactive "P") (jao-afio--check-frame) - (jao-afio--goto-frame ?c reset)) - -(defun jao-afio--goto-scratch (&optional reset) + (let ((current (jao-afio--current-config))) + (if (and jao-afio-auto-toggle + (eq next current) + (not reset) + (not (eq current jao-afio--previous-config))) + (jao-afio--goto-frame jao-afio--previous-config) + (when (or reset (not (eq next current))) + (if jao-afio-use-frames + (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))))) + (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))))) + +(defun jao-afio-goto-main (&optional reset) (interactive "P") - (jao-afio--check-frame) - (jao-afio--goto-frame ?s reset)) + (jao-afio--goto-frame ?c reset)) -(defun jao-afio--goto-mail (&optional reset) +(defun jao-afio-goto-mail (&optional reset) (interactive "P") - (jao-afio--check-frame) (jao-afio--goto-frame ?g reset)) -(defun jao-afio--goto-docs (&optional reset) +(defun jao-afio-goto-docs (&optional reset) (interactive "P") - (jao-afio--check-frame) (jao-afio--goto-frame ?p reset)) -(defun jao-afio--goto-www (&optional reset) +(defun jao-afio-goto-www (&optional reset) (interactive "P") - (if (jao-afio--check-frame-p) - (jao-afio--goto-frame ?w reset) - (when (and jao-afio-use-w3m (w3m-alive-p)) - (pop-to-buffer (w3m-alive-p))))) - -(defun jao-afio--try-init (&optional f) - (ignore-errors (jao-afio--init f)) - t) - -(defun jao-afio--goto-www-buffer (buf &rest _) - (jao-afio--goto-www) - (jao-first-window) - (switch-to-buffer buf nil t)) - -(defun jao-afio--goto-pdf-buffer (buf &rest _) - (if (jao-afio--check-frame-p) - (progn (jao-afio--goto-docs) - (jao-first-window) - (switch-to-buffer buf nil t)) - (pop-to-buffer buf))) + (jao-afio--goto-frame ?w reset)) + +(defun jao-afio-toggle () + (interactive) + (jao-afio--goto-frame jao-afio--previous-config)) (defun jao-afio-goto-scratch (&optional one-win) - (jao-afio--goto-scratch) + (interactive "P") + (jao-afio--goto-frame ?s nil) (when one-win (delete-other-windows))) -(defun jao-afio-current-frame () - (cl-case jao-afio--current-config - (?c "Main") - (?s "Scratch") - (?g "Mail") - (?p "Docs") - (?w "Web"))) - -(defun jao-afio-current-no () - (cl-case jao-afio--current-config - (?c "1") - (?s "0") - (?g "2") - (?p "4") - (?w "3"))) +(defun jao-afio-goto-chats (&optional reset) + (interactive "P") + (jao-afio--goto-frame ?t reset)) ;;;###autoload (defun jao-afio-goto-nth (n) (cl-case n - ((1) (jao-afio--goto-main)) - ((2) (jao-afio--goto-mail)) - ((3) (jao-afio--goto-www)) - ((4) (jao-afio--goto-docs)) - ((5) (jao-afio--goto-scratch-1)) - ((0) (jao-afio--goto-scratch)))) + ((-1) (jao-afio-goto-scratch t)) + ((0) (jao-afio-goto-scratch)) + ((1) (jao-afio-goto-main)) + ((2) (jao-afio-goto-mail)) + ((3) (jao-afio-goto-www)) + ((4) (jao-afio-goto-docs)) + ((5) (jao-afio-goto-chats)))) + +;;;###autoload +(defun jao-afio-pop-to-buffer (n buff) + (interactive "NFrame number: \nBBuffer: ") + (jao-afio-goto-nth n) + (pop-to-buffer buff)) +;;; setup ;;;###autoload -(defun jao-afio-setup (&optional fallback-fun init-p) - (global-set-key "\C-cf" 'jao-afio--goto-main) - (global-set-key "\C-cg" 'jao-afio--goto-mail) - (global-set-key "\C-cw" 'jao-afio--goto-www) - (global-set-key "\C-cz" 'jao-afio--goto-docs) - (setq jao-afio-fallback-fun fallback-fun) - (add-hook (if init-p 'after-init-hook 'after-make-frame-functions) - 'jao-afio--try-init)) +(defun jao-afio-setup (&optional use-frames) + (setq jao-afio-use-frames use-frames) + (jao-afio--init)) (provide 'jao-afio) ;;; jao-afio.el ends here diff --git a/lib/eos/jao-dirmon.el b/lib/eos/jao-dirmon.el index 4fb8609..9d748d1 100644 --- a/lib/eos/jao-dirmon.el +++ b/lib/eos/jao-dirmon.el @@ -34,13 +34,29 @@ (defun jao-dirmon-sizes () (mapcar (lambda (f) - (let ((x (split-string (jao-shell-string "du -s" f)))) + (let ((x (split-string (jao-shell-string "du -BM -s" f)))) (cons (cadr x) (string-to-number (car x))))) (jao-dirmon-dirs))) -(defvar jao-dirmon-threshold 100000) +(defvar jao-dirmon-threshold 100) (defvar jao-dirmon-last-delta nil) +(defun jao-dirmon--show-deltas (old current deltas) + (with-temp-buffer + (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)))) + (insert "\n\nSizeable dirs\n\n") + (let ((threshold (* 10 jao-dirmon-threshold))) + (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) + (pop-to-buffer (current-buffer) nil t) + (when (y-or-n-p "Save current state?") + (setf (multisession-value jao-dirmon-last) + (cons (current-time-string) current))))) + ;;;###autoload (defun jao-dirmon-report () (interactive) @@ -49,12 +65,10 @@ (high ())) (dolist (c current) (let ((d (- (cdr c) (alist-get (car c) old 0 nil #'string=)))) - (when (> d jao-dirmon-threshold) + (when (> (abs d) jao-dirmon-threshold) (push c high)))) (setq jao-dirmon-last-delta high) - (let ((prompt (format"High deltas: %s. Save state?" high))) - (when (y-or-n-p prompt) - (setf (multisession-value jao-dirmon-last) current))) + (jao-dirmon--show-deltas old current jao-dirmon-last-delta) jao-dirmon-last-delta)) (provide 'jao-dirmon) diff --git a/lib/eos/jao-ednc.el b/lib/eos/jao-ednc.el index 5750ea7..92ee21f 100644 --- a/lib/eos/jao-ednc.el +++ b/lib/eos/jao-ednc.el @@ -1,6 +1,6 @@ ;;; jao-ednc.el --- Minibuffer notifications using EDNC -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021 jao +;; Copyright (C) 2020, 2021, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: tools, abbrev @@ -91,9 +91,8 @@ (when old (funcall (jao-ednc--handler old) old nil)) (when new (funcall (jao-ednc--handler new) new t))) -;;;###autoload (defun jao-ednc-setup (minibuffer-order) - (setq jao-notify-use-messages-p t) + (setq jao-notify-use-messages t) (with-eval-after-load "tracking" (when jao-ednc-use-tracking (add-to-list 'tracking-faces-priorities 'jao-ednc-tracking) @@ -104,19 +103,16 @@ (add-hook 'ednc-notification-presentation-functions #'jao-ednc--on-notify) (ednc-mode)) -;;;###autoload (defun jao-ednc-pop () (interactive) (pop-to-buffer-same-window ednc-log-name)) -;;;###autoload (defun jao-ednc-show () (interactive) (if (not (jao-ednc--last-notification)) (jao-ednc-pop) (jao-ednc--show-last))) -;;;###autoload (defun jao-ednc-invoke-last-action () (interactive) (if (jao-ednc--last-notification) @@ -124,7 +120,6 @@ (message "No active notifications")) (jao-ednc--clean)) -;;;###autoload (defun jao-ednc-dismiss () (interactive) (when (jao-ednc--last-notification) @@ -133,7 +128,12 @@ (ednc-dismiss-notification (jao-ednc--last-notification))))) (jao-ednc--clean)) -;;;###autoload +(defun jao-ednc-dismiss-and-show () + (interactive) + (let ((m (jao-ednc--format-last))) + (jao-ednc-dismiss) + (when m (message m)))) + (defun jao-ednc-dismiss-all () (interactive) (while (jao-ednc--last-notification) diff --git a/lib/eos/jao-eshell-here.el b/lib/eos/jao-eshell-here.el index cf29e31..54d58f0 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 jao +;; Copyright (C) 2021, 2023 jao ;; Author: jao <mail@jao.io> ;; Keywords: eshell @@ -64,7 +64,7 @@ C-u) open in the current's buffer default dir." (jao-with-attached-buffer "^\\*eshell" 0.5 (if (buffer-live-p b) (progn (pop-to-buffer b nil t) - (eshell-save-some-history) + ;; (eshell-save-some-history) (when dir (jao-eshell--cd-here dir))) (let ((default-directory (or dir default-directory))) (eshell (when force-new 4))) @@ -75,7 +75,7 @@ C-u) open in the current's buffer default dir." (when (derived-mode-p 'eshell-mode) (when (fboundp 'eshell-autojump-save) (eshell-autojump-save)) - (eshell-save-some-history) + ;; (eshell-save-some-history) (if (> (frame-height) (window-height)) (delete-window) (bury-buffer)))) diff --git a/lib/eos/jao-minibuffer.el b/lib/eos/jao-minibuffer.el index bdafa74..77bd49a 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 jao +;; Copyright (C) 2020, 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: extensions @@ -27,11 +27,13 @@ (defvar jao-minibuffer-info ()) (defvar jao-minibuffer-msg-info '("")) (defvar jao-minibuffer-align-right t) -(defvar jao-minibuffer-right-margin (if window-system 0 2)) +(defvar jao-minibuffer-adaptive-alignment t) +(defvar jao-minibuffer-right-margin (if window-system 0 1)) (defvar jao-minibuffer-maximized-frames-p t) (defvar jao-minibuffer-frame-width nil) (defvar jao-minibuffer-active-buffer-line-color "azure4") (defvar jao-minibuffer-inactive-buffer-line-color "grey25") +(defvar jao-minibuffer-inhibit nil) (defconst jao-minibuffer--name " *Minibuf-0*") @@ -57,19 +59,17 @@ (msg (cond (jao-minibuffer-align-right (string-trim msg)) (t (string-trim-left msg))))) (unless (string-empty-p msg) - (let ((msg (propertize msg :minibuffer-message t)) + (let ((msg (propertize msg 'minibuffer-message t)) (w (- (jao-minibuffer--width) w jao-minibuffer-right-margin))) (if (> w 0) (jao-minibuffer--trim msg w) ""))))) (defun jao-minibuffer--insert (msg) - (let ((hack (derived-mode-p 'pdf-view-mode 'doc-view-mode))) - (with-current-buffer jao-minibuffer--name - (delete-region (point-min) (point-max)) - (insert msg) - (when hack (other-window 1) (other-window -1))))) + (with-current-buffer jao-minibuffer--name + (delete-region (point-min) (point-max)) + (insert msg))) (defun jao-minibuffer--strip-prev (msg) - (if-let ((n (text-property-any 0 (length msg) :minibuffer-message t msg))) + (if-let ((n (text-property-any 0 (length msg) 'minibuffer-message t msg))) (string-trim (substring msg 0 n)) msg)) @@ -78,16 +78,38 @@ (unless (string-blank-p p) (concat p "\n")))) (defun jao-minibuffer--format-msg (msg) - (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n"))) + (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)) - (msg (car (last msgs))) + (msg (or (car (last msgs)) "")) (w (string-width msg))) (if jao-minibuffer-align-right (concat prefix msg (jao-minibuffer--aligned w)) (concat prefix (jao-minibuffer--aligned (+ 3 w)) " " msg)))) (defun jao-minibuffer--set-message (msg) - (when jao-minibuffer-mode (jao-minibuffer--format-msg (or msg "")))) + (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) "")))) + (msg (if (and msg pref) + (replace-regexp-in-string "\n" pref msg) + msg)) + (left (if jao-minibuffer-align-right info (or msg ""))) + (right (if jao-minibuffer-align-right (or msg "") info)) + (msg (or (if info (format "%s%s%s" left sep right) msg) ""))) + (if cursor-in-echo-area msg (jao-minibuffer--format-msg msg)))))) + +(defun jao-minibuffer--clear-message () + (let ((jao-minibuffer-inhibit nil)) + (or (jao-minibuffer--insert (jao-minibuffer--set-message nil)) t))) (setq set-message-function #'jao-minibuffer--set-message) @@ -96,35 +118,38 @@ (set list-name (remove v (symbol-value list-name))) (add-to-ordered-list list-name v order))) -;;;###autoload +(defun jao-minibuffer--adjust-alignment (&rest _) + (when jao-minibuffer-adaptive-alignment + (setq jao-minibuffer-align-right + (< (or (car (window-absolute-pixel-edges)) 0) + (/ (or (cadr (assoc 'outer-size (frame-geometry))) 0) 2)))) + (jao-minibuffer-refresh)) + (defun jao-minibuffer-add-variable (variable-name &optional order) (jao-minibuffer--add-variable 'jao-minibuffer-info variable-name order)) -;;;###autoload (defun jao-minibuffer-add-msg-variable (variable-name &optional order) (jao-minibuffer--add-variable 'jao-minibuffer-msg-info variable-name order)) -;;;###autoload (defun jao-minibuffer-remove-variable (variable-name) (let ((v `(:eval ,variable-name))) (setq jao-minibuffer-info (remove v jao-minibuffer-info)) - (setq jao-minibuffer-msg-info (remove v jao-minibuffer-info)))) + (setq jao-minibuffer-msg-info (remove v jao-minibuffer-msg-info)))) -;;;###autoload (define-minor-mode jao-minibuffer-mode "Show minibuffer status" :global t :lighter "" :group 'jao (if jao-minibuffer-mode - (progn (advice-add 'select-window :after #'jao-minibuffer-refresh) + (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-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) (jao-minibuffer--insert ""))) -;;;###autoload (defun jao-minibuffer-refresh (&rest _ignore) (interactive) (when jao-minibuffer-mode @@ -133,5 +158,11 @@ (jao-minibuffer--format-info jao-minibuffer-msg-info)))) (jao-minibuffer--insert (jao-minibuffer--format-msg (or msg "")))))) +(defun jao-minibuffer-toggle-adaptive-alignment () + (interactive) + (setq jao-minibuffer-adaptive-alignment + (not jao-minibuffer-adaptive-alignment)) + (jao-minibuffer-refresh)) + (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 0fd5a2e..e4f64c0 100644 --- a/lib/eos/jao-mode-line.el +++ b/lib/eos/jao-mode-line.el @@ -48,10 +48,17 @@ (interactive "P") (jao-mode-line--face-height 'mode-line-inactive all)) +(defun jao-mode-line--old-str () + (thread-first (format-mode-line jao-mode-line--old-format) + (substring-no-properties) + (string-trim))) + ;;;###autoload (defun jao-mode-line-echo () (interactive) - (message "%s" (format-mode-line mode-line-format))) + (message "%s" (jao-mode-line--old-str)) + (setq-local header-line-format + (if header-line-format nil jao-mode-line--old-format))) ;;;###autoload (defun jao-mode-line-hide-inactive (frame) @@ -78,8 +85,8 @@ '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)))) + ;; ((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")))) @@ -120,32 +127,49 @@ (if inactive jao-mode-line--inactive-face jao-mode-line--face))) (defun jao-mode-line-adjust-faces () - (let ((bg (frame-parameter nil 'background-color))) + (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))) (jao-mode-line--extract-face nil) (jao-mode-line--extract-face t) (set-face-attribute 'mode-line nil :box nil :height 1 :background bg :foreground bg - :overline jao-minibuffer-active-buffer-line-color - :underline jao-minibuffer-inactive-buffer-line-color - :extend t) + :overline ol :underline ul :extend t) (set-face-attribute 'mode-line-inactive nil :box nil :height 1 :background bg :foreground bg ;; :overline bg - :underline jao-minibuffer-inactive-buffer-line-color - :extend t))) + :underline ul :extend t))) -;;;###autoload -(defun jao-mode-line-add-to-minibuffer (&optional order) +(defun jao-mode-line--maybe-refresh () + (when (mode-line-window-selected-p) (jao-minibuffer-refresh))) + +(defconst jao-mode-line--hidden-format + '("" (:eval (jao-mode-line--maybe-refresh)))) + +(defun jao-mode-line--add-to-minibuffer (order msg-p) (interactive) (setq jao-mode-line--old-format mode-line-format) - (setq-default mode-line-format '(" ")) + (setq-default mode-line-format jao-mode-line--hidden-format) (setq-default mode-line-position jao-mode-line--position) (dolist (b (buffer-list)) - (with-current-buffer b (setq-local mode-line-format '(" ")))) - (jao-minibuffer-add-variable 'jao-mode-line--format (or order 90)) + (with-current-buffer b + (setq-local mode-line-format jao-mode-line--hidden-format))) + (if msg-p + (jao-minibuffer-add-msg-variable '(jao-mode-line--old-str) (or order 90)) + (jao-minibuffer-add-variable 'jao-mode-line--format (or order 90))) (jao-mode-line-adjust-faces)) ;;;###autoload +(defun jao-mode-line-add-to-minibuffer-right (&optional order) + (interactive) + (jao-mode-line--add-to-minibuffer order nil)) + +;;;###autoload +(defun jao-mode-line-add-to-minibuffer-left (&optional order) + (interactive) + (jao-mode-line--add-to-minibuffer order t)) + +;;;###autoload (defun jao-mode-line-remove-from-minibuffer () (interactive) (jao-mode-line--revert-face nil) @@ -154,7 +178,8 @@ (dolist (b (buffer-list)) (with-current-buffer b (setq-local mode-line-format jao-mode-line--old-format))) - (jao-minibuffer-remove-variable 'jao-mode-line--format)) + (jao-minibuffer-remove-variable 'jao-mode-line--format) + (jao-minibuffer-remove-variable '(jao-mode-line--old-str))) (provide 'jao-mode-line) diff --git a/lib/eos/jao-notify.el b/lib/eos/jao-notify.el index a3ea474..623b8cc 100644 --- a/lib/eos/jao-notify.el +++ b/lib/eos/jao-notify.el @@ -1,6 +1,6 @@ ;; jao-notify.el -- Interacting with notification daemon -;; Copyright (c) 2017, 2019, 2020, 2021 Jose Antonio Ortega Ruiz +;; Copyright (c) 2017, 2019, 2020, 2021, 2024 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sun Jan 08, 2017 20:24 @@ -12,7 +12,7 @@ ;;; Code: -(defvar jao-notify-use-messages-p nil) +(defvar jao-notify-use-messages nil) (defvar jao-notify-timeout 5000) (defvar jao-notify-audio-icon (jao-data-file "music-player-icon.png")) @@ -23,7 +23,7 @@ (defun jao-notify (msg &optional title icon) (let ((title (when (and title (not (string-blank-p title))) title))) - (if jao-notify-use-messages-p + (if jao-notify-use-messages (message "%s%s%s" (or title "") (if title ": " "") (or msg "")) (let* ((args `(:timeout ,jao-notify-timeout)) (args (append args diff --git a/lib/eos/jao-shell.el b/lib/eos/jao-shell.el index ff1c160..86bf46b 100644 --- a/lib/eos/jao-shell.el +++ b/lib/eos/jao-shell.el @@ -24,25 +24,29 @@ ;;; Code: -(defun jao-shell--quote (x) (shell-quote-argument (format "%s" x))) - -;;;###autoload (defun jao-shell-cmd-lines (cmd &rest args) - (let ((cmd (concat cmd " " (mapconcat #'jao-shell--quote args " ")))) + (let ((cmd (concat cmd " " (combine-and-quote-strings args)))) (split-string (shell-command-to-string cmd) "\n" t))) -;;;###autoload (defun jao-shell-string (cmd &rest args) (string-trim (or (car (apply #'jao-shell-cmd-lines cmd args)) ""))) -;;;###autoload -(defun jao-shell-exec (command) +(defun jao-shell-exec (command &optional wait) (interactive (list (read-shell-command "$ " (if current-prefix-arg (cons (concat " " (buffer-file-name)) 0) "")))) - (start-process-shell-command command nil command)) + (if wait + (call-process-shell-command command) + (start-process-shell-command command nil command))) + +(defun jao-shell-exec* (command-or-wait &rest args) + (let ((wait (and (not (stringp command-or-wait)) command-or-wait)) + (args (if (stringp command-or-wait) (cons command-or-wait args) args))) + (jao-shell-exec (combine-and-quote-strings args) wait))) + +(defun jao-shell-exec-p (command) (eq 0 (jao-shell-exec command t))) (defmacro jao-shell-def-exec (name &rest args) `(defun ,name (&rest other-args) @@ -52,9 +56,14 @@ "*jao-exec - console*" (string-join (append (list ,@args) other-args) " ")))) -;;;###autoload -(defun jao-shell-running-p (pr) - (not (string-blank-p (shell-command-to-string (concat "pidof " pr))))) +(defun jao-shell-output (cmd handler) + (with-temp-buffer + (call-process-shell-command cmd nil (current-buffer)) + (beginning-of-buffer) + (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 93da0e7..b047373 100644 --- a/lib/eos/jao-sleep.el +++ b/lib/eos/jao-sleep.el @@ -41,12 +41,12 @@ "Register actions to take on sleep and on awake, using the system D-BUS." (when (featurep 'dbusbind) (setq jao-sleep--dbus-sleep-registration-object - (dbus-register-signal (if session-dbus :session :system) - "org.freedesktop.login1" - "/org/freedesktop/login1" - "org.freedesktop.login1.Manager" - "PrepareForSleep" - #'jao-sleep--dbus-sleep-handler)))) + (dbus-register-signal (if session-dbus :session :system) + "org.freedesktop.login1" + "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" + "PrepareForSleep" + #'jao-sleep--dbus-sleep-handler)))) ;;;###autoload (defun jao-sleep-dbus-unregister () diff --git a/lib/eos/jao-tracking.el b/lib/eos/jao-tracking.el index 520116d..2af868c 100644 --- a/lib/eos/jao-tracking.el +++ b/lib/eos/jao-tracking.el @@ -1,6 +1,6 @@ -;;; jao-minibuffer-tracking.el --- Tracking notifications in minibuffer -*- lexical-binding: t; -*- +;; jao-minibuffer-tracking.el --- Tracking notifications -*- lexical-binding: t; -*- -;; Copyright (C) 2021 jao +;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -18,33 +18,33 @@ ;; 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: +;;; require (require 'tracking) (require 'shorten) (require 'jao-minibuffer) +(require 'jao-afio) - -;; shorten +;;; shorten +;;;###autoload (defun jao-shorten-modes (&rest modes) (dolist (m modes) (add-to-list 'tracking-shorten-modes m))) -(defun jao-tracking--clean-slack (s) - (let* ((s (replace-regexp-in-string - "^\\*Slack - .*? : \\(mpdm-\\)?\\([^ ]+\\)\\( \\(T\\)\\)?.*" - "#\\2\\4" - s)) - (s (replace-regexp-in-string "logstash-\\([^-]+\\)-\\(.+\\)" - "\\2-\\1" - s))) - (replace-regexp-in-string "^[^a-zA-Z#]+" "#" s))) +(defvar jao-tracking-cleaners '(("^[^a-zA-Z#@]+" . "#"))) + +;;;###autoload +(defun jao-tracking-cleaner (rx subst) + (add-to-list 'jao-tracking-cleaners (cons rx subst))) (defun jao-tracking-shorten-aggressively (lst tail-count) - (let* ((s (shorten-join-sans-tail lst tail-count))) + (let ((s (shorten-join-sans-tail lst tail-count))) (if (string-match-p "^#" s) (substring s 1 nil) s))) (defun jao-tracking-split-clean (s) - (shorten-split (jao-tracking--clean-slack s))) + (dolist (cln jao-tracking-cleaners) + (when (string-match (car cln) s) + (setq s (replace-match (cdr cln) nil nil s)))) + (shorten-split s)) (defun jao-tracking-shorten (old-func &rest args) (let ((shorten-join-function #'jao-tracking-shorten-aggressively) @@ -53,14 +53,15 @@ (advice-add #'tracking-shorten :around #'jao-tracking-shorten) - -;; additional highlighting +;;; additional highlighting (defvar jao-tracking-highlight-rx "$^") +;;;###autoload (defun jao-tracking-faces (&rest faces) (dolist (face faces) (add-to-list 'tracking-faces-priorities face))) +;;;###autoload (defun jao-tracking-add-buffer (old-func &rest args) (let* ((buffer (car args)) (faces (if (and buffer @@ -73,8 +74,7 @@ (advice-add 'tracking-add-buffer :around #'jao-tracking-add-buffer) (jao-tracking-faces 'lui-highlight-face) - -;; minibuffer +;;; minibuffer (defvar jao-tracking-string "") (defvar jao-tracking-bkg "grey93") @@ -84,11 +84,21 @@ `((t :foreground ,jao-tracking-bkg :background ,jao-tracking-bkg)) "" :group 'faces) +(defvar jao-tracking--pipe + (let ((name "/tmp/emacs.status")) + (unless (file-exists-p name) + (shell-command (format "mkfifo %s" name name))) + name)) + (defun jao-tracking-set-log (v) (when (member window-system '(x)) - (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0))) - -(jao-tracking-set-log "") + (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0)) + (if 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")) + (cmd (format "wmctrl -r emacs -b %s,demands_attention" action))) + (shell-command-to-string cmd)))) (defun jao-tracking--buffer-str (s) (if (listp s) @@ -114,10 +124,59 @@ (setq jao-tracking-string (jao-tracking-build-str new-val)) (jao-minibuffer-refresh)) -(jao-minibuffer-add-variable 'jao-tracking-string -10) -(add-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) -;; since we're using the minibuffer, forget the mode line -(advice-add #'tracking-mode :override (lambda (&optional _) (interactive))) +(defvar jao-tracking-use-scratch 5) +(defvar jao-tracking--start-frame nil) + +(defun jao-tracking--remove-visible-buffers () + (unless (and jao-afio-use-frames jao-tracking-use-scratch) + (tracking-remove-visible-buffers))) + +;;; package setup +;;;###autoload +(defun jao-tracking-go-to-chats () + (interactive) + (when jao-tracking-use-scratch + (jao-afio-goto-nth jao-tracking-use-scratch))) + +;;;###autoload +(defun jao-tracking-next-buffer () + (interactive) + (if jao-tracking-use-scratch + (let ((k (if (numberp jao-tracking-use-scratch) jao-tracking-use-scratch 0)) + (n (jao-afio-frame-no))) + (unless (eq k n) (setq jao-tracking--start-frame n)) + (cond (tracking-buffers + (let ((bs tracking-buffers)) + (if (eq k n) + (tracking-next-buffer) + (jao-afio-goto-nth k) + (when (and (car bs) (not (memq (current-buffer) bs))) + (pop-to-buffer (car bs))) + (tracking-remove-visible-buffers)))) + (jao-tracking--start-frame + (jao-afio-goto-nth jao-tracking--start-frame) + (setq jao-tracking--start-frame nil)))) + (tracking-next-buffer)) + (jao-tracking-update-minibuffer)) + +(defun jao-tracking-add-to-minibuffer () + (interactive) + (jao-minibuffer-add-variable 'jao-tracking-string -10) + (add-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) + (advice-add #'tracking-mode :override (lambda (&optional _) (interactive)))) + +(defun jao-tracking-remove-from-minibuffer () + (interactive) + (jao-minibuffer-remove-variable 'jao-tracking-string) + (remove-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) + (advice-remove #'tracking-mode (lambda (&optional _) (interactive)))) + +;;;###autoload +(defun jao-tracking-setup (&optional minibuffer) + (when minibuffer (jao-tracking-add-to-minibuffer)) + (add-hook 'jao-afio-switch-hook #'jao-tracking--remove-visible-buffers) + (global-set-key (kbd "C-c C-SPC") #'jao-tracking-next-buffer) + (define-key tracking-mode-map (kbd "C-c C-SPC") #'jao-tracking-next-buffer)) (provide 'jao-tracking) ;;; jao-minibuffer-tracking.el ends here diff --git a/lib/eos/jao-wayland.el b/lib/eos/jao-wayland.el new file mode 100644 index 0000000..9458ccb --- /dev/null +++ b/lib/eos/jao-wayland.el @@ -0,0 +1,181 @@ +;;; jao-wayland.el --- interacting with wayland compositors -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2023 jao + +;; Author: jao <mail@jao.io> +;; Keywords: convenience + +;; 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) +(require 'jao-pdf) +(require 'jao-tracking) + +;;; wayland +(defvar jao-wayland-enabled + (string= "wayland" (or (getenv "XDG_SESSION_TYPE") ""))) + +(defsubst jao-wayland-type (&rest args) + (apply #'jao-shell-exec* t "wtype" args)) + +;;; river +(defvar jao-river-enabled (jao-shell-running-p "river")) +(defun jao-river-enabled-p () jao-river-enabled) + +(defsubst jao-river-to-ws (n) + (jao-wayland-type "-M" "win" (format "%s" n))) + +(defsubst jao-river-window-list () + (alist-get 'toplevels + (jao-shell-output "lswt -j" + (lambda () + (let ((json-false nil)) (json-read)))))) + +(defun jao-river-focused () + (seq-some (lambda (w) (and (alist-get 'activated w) w)) + (jao-river-window-list))) + +(defsubst jao-river-get-focused-title () + (alist-get 'title (jao-river-focused))) + +(defsubst jao-river-get-focused-app-id () + (alist-get 'app-id (jao-river-focused))) + +(defun jao-river-focus-window (title &optional rx) + (let* ((ws (jao-river-window-list)) + (fltr (if rx #'string-match-p #'string=)) + (w (seq-find (lambda (w) + (or (funcall fltr title (alist-get 'app_id w "")) + (funcall fltr title (alist-get 'title w "")))) + ws))) + (or (alist-get 'activated w) + (seq-some (lambda (_ignored) + (jao-shell-exec "riverctl focus-view next" t) + (or (funcall fltr title (jao-river-get-focused-app-id)) + (funcall fltr title (jao-river-get-focused-title)))) + (and w ws))))) + +(defun jao-river-zathura-to-org () + (let ((title (jao-river-get-focused-title))) + (jao-river-to-ws 1) + (jao-org-open-from-zathura title t))) + +(defun jao-river-zathura-kill-link () + (when-let* ((title (jao-river-get-focused-title)) + (lnk (jao-pdf-zathura-org-link title))) + (jao-river-to-ws 1) + (kill-new lnk) + (message "Link to %s killed" title))) + +(defun jao-river-find-zathura-window (file) + (let ((frx (regexp-quote (file-name-nondirectory file)))) + (seq-some (lambda (w) + (and (string-suffix-p ".zathura" (alist-get 'app_id w "")) + (string-match-p frx (alist-get 'title w "")) + w)) + (jao-river-window-list)))) + +(defun jao-river-open-with-zathura (file page) + (let ((wd (jao-river-find-zathura-window file))) + (jao-river-to-ws 3) + (or (and wd (jao-river-focus-window (alist-get 'title wd))) + (jao-shell-exec* "riverctl" "spawn" (jao-pdf-zathura-open-cmd file page))) + (when page (sit-for 0.2) (jao-wayland-type (format "%dg" page))))) + +(defun jao-river-set-wallpaper (f) + (jao-shell-kill-p "swaybg") + (jao-shell-exec* "riverctl" "spawn" (concat "swaybg -m fill -i " f))) + +(defun jao-river-restart-i3bar () + (interactive) + (jao-shell-kill-p "i3bar-river") + (jao-shell-exec "riverctl spawn i3bar-river") + (sit-for 0.2) + (jao-tracking-set-log "")) + +(defun jao-river-toggle-emacs () + (let ((erx "^p?emacs\\(client\\)?\\|\\(.* - emacs\\)")) + (if (or (string-match-p erx (jao-river-get-focused-title)) + (string-match-p erx (jao-river-get-focused-app-id))) + (jao-shell-exec "riverctl focus-previous-tags") + (jao-river-to-ws 1) + (unless (jao-river-focus-window erx t) + (jao-shell-exec* "riverctl" "spawn" "efoot"))))) + +(defun jao-river-toggle-firefox () + (if (string-match-p "Firefox" (or (jao-river-get-focused-app-id) "")) + (jao-river-to-ws 1) + (jao-river-to-ws 2) + (unless (jao-river-focus-window "Firefox") + (jao-shell-exec* "riverctl" "spawn" "firefox")))) + +;;; sway +(defun jao-sway-msg (msg) + (shell-command (format "swaymsg '%s' >/dev/null" msg))) + +(defmacro jao-def-swaymsg (name msg) + `(defun ,(intern (format "jao-sway-%s" name)) () + (interactive) + (jao-sway-msg ,msg))) + +(jao-def-swaymsg firefox "[app_id=Firefox] focus") +(jao-def-swaymsg pemacs "[app_id=pemacs] focus") + +(defvar jao-sway-enabled (jao-shell-running-p "sway")) + +(defconst jao-sway-get-active-title + "swaymsg -t get_tree | jq '.. | select(.type?) | select(.focused==true).name'") + +(defconst jao-sway-get-active-app + "swaymsg -t get_tree | jq '.. | select(.type?) | select(.focused==true).app_id'") + +(defun jao-sway-get-active-title () + (let ((tl (jao-shell-string jao-sway-get-active-title))) + (and (string-match "\"\\(.+\\)\"" tl) (match-string 1 tl)))) + +(defun jao-sway-get-active-app () + (let ((tl (jao-shell-string jao-sway-get-active-app))) + (and (string-match "\"\\(.+\\)\"" tl) (match-string 1 tl)))) + +(defun jao-sway-zathura-org () + (jao-org-open-from-zathura (jao-sway-get-active-title) t)) + +(defun jao-sway-open-with-zathura (file page) + (let* ((n (file-name-nondirectory file)) + (m (format "[title=\"%s\" app_id=\".*zathura\"] focus" n))) + (jao-sway-msg "workspace number 3") + (unless (= 0 (jao-sway-msg m)) + (jao-shell-exec (jao-pdf-zathura-open-cmd file page))) + (when page (sit-for 0.2) (jao-wayland-type (format "%dg" page))))) + +(defun jao-sway-set-wallpaper (f) + (jao-sway-msg (format "output * bg %s fill" f))) + +(defun jao-sway-run-or-focus (cmd &optional ws) + (if (jao-shell-running-p "firefox") + (jao-sway-msg (format "[app_id=%s] focus" cmd)) + (jao-sway-msg (format "workspace %s" (or ws 2))) + (start-process-shell-command cmd nil cmd))) + +(defun jao-sway-run-or-focus-firefox () + (interactive) + (jao-sway-run-or-focus "firefox")) + +(defun jao-sway-toggle-emacs () + (if (string-match-p "p?emacs" (jao-sway-get-active-app)) + (jao-sway-firefox) + (jao-sway-pemacs))) + +(provide 'jao-wayland) +;;; jao-wayland.el ends here diff --git a/lib/media/jao-lyrics.el b/lib/media/jao-lyrics.el index 5008fae..985c9d9 100644 --- a/lib/media/jao-lyrics.el +++ b/lib/media/jao-lyrics.el @@ -76,7 +76,7 @@ (use-local-map jao-lyrics-mode-map) (setq major-mode 'jao-lyrics-mode) (setq mode-name "lyrics") - (toggle-read-only 1)) + (read-only-mode)) (defun jao-lyrics-buffer () (or (get-buffer "*Lyrics*") diff --git a/lib/media/jao-mpc.el b/lib/media/jao-mpc.el index dc8ff6d..0f000da 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 jao +;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -38,62 +38,88 @@ (defvar-local jao-mpc--port nil) (defun jao-mpc--cmd (cmd &optional port) - (let ((port (or port jao-mpc--port jao-mpc-port))) - (shell-command-to-string (format "mpc -p %s %s" port cmd)))) + (let* ((port (or port jao-mpc--port jao-mpc-port)) + (r (shell-command-to-string (format "mpc -p %s %s" port cmd)))) + (replace-regexp-in-string "^\\(warning: \\)?MPD .+\n" "" r))) + +(defun jao-mpc--fformat (fields) + (mapconcat (lambda (f) (format "%s:::%%%s%%" f f)) fields "\n")) (defconst jao-mpc--fields '(artist album composer originaldate genre title track position time name)) (defconst jao-mpc--stfmt - (mapconcat (lambda (f) (format "%s:::%%%s%%" f f)) jao-mpc--fields "\n")) + (jao-mpc--fformat + '(artist album composer originaldate genre title track name))) + +(defconst jao-mpc--stfmtt + (jao-mpc--fformat '(currenttime totaltime percenttime songpos length))) + +(defmacro jao-mpc--parse-fields (res-str res) + `(dolist (s (split-string ,res-str "\n" t " ") ,res) + (when (string-match "\\(.+\\):::\\(.+\\)" s) + (push (cons (intern (match-string 1 s)) (match-string 2 s)) ,res)))) (defun jao-mpc--current (&optional port) (let ((s (jao-mpc--cmd (format "-f '%s' current" jao-mpc--stfmt) port)) + (st (jao-mpc--cmd (format "status '%s'" jao-mpc--stfmtt))) (res)) - (dolist (s (split-string s "\n" t " ") res) - (when (string-match "\\(.+\\):::\\(.+\\)" s) - (push (cons (intern (match-string 1 s)) (match-string 2 s)) res))))) + (jao-mpc--parse-fields s res) + (jao-mpc--parse-fields st res))) + +(defsubst jao-mpc-status (&optional port) + (string-trim (jao-mpc--cmd "status %state%" port))) -(defun jao-mpc--playing-p (&optional port) - (not (string-blank-p (jao-mpc--cmd "status|grep '\\[playing\\]'" port)))) +(defsubst jao-mpc-playing-p (&optional port) + (string-prefix-p "playing" (jao-mpc-status port))) -(defun jao-mpc--queue-len (&optional port) - (string-to-number (jao-mpc--cmd "playlist|wc -l" port))) +(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-str (&optional port current len) - (let* ((current (or current (jao-mpc--current port))) - (len (or len (jao-mpc--queue-len port))) - (title (alist-get 'title current (alist-get 'name current ""))) - (album (alist-get 'album current)) - (artist (alist-get 'artist current)) - (composer (alist-get 'composer current)) - (no (string-to-number (alist-get 'position current "0"))) - (time (alist-get 'time current ""))) - (format "> %s%s %s%s%s%s" ;;  - (jao--put-face (if (zerop no) "" (format "%02d/%s " no len)) - 'jao-themes-f02) - (jao--put-face title 'jao-themes-f00) - (jao--put-face artist 'jao-themes-f01) - (jao--put-face (if composer (format " [%s]" composer) "") - 'jao-themes-f01) - (jao--put-face (if album (format " (%s)" album) "") 'jao-themes-f11) - (if (string-blank-p time) - "" - (jao--put-face (format " [%s]" time) 'jao-themes-dimm))))) +(defun jao-mpc--current-timestr (playing-times &optional current) + (let* ((current (or current (jao-mpc--current))) + (time (alist-get 'totaltime current ""))) + (if playing-times + (format "%s/%s%s" + (alist-get 'currenttime current "") + time + (alist-get 'percenttime current "")) + (format "%s" time)))) + +(defun jao-mpc--current-str (&optional port times) + (if-let* ((current (jao-mpc--current port)) + (title (alist-get 'title current (alist-get 'name current)))) + (let ((len (alist-get 'length current "0")) + (album (alist-get 'album current)) + (artist (alist-get 'artist current)) + (composer (alist-get 'composer current)) + (no (string-to-number (alist-get 'songpos current "0"))) + (tims (concat " [" (jao-mpc--current-timestr times current) "]"))) + (format "%s%s %s%s%s%s" ;;  + (jao--put-face (if (zerop no) "" (format "%d/%s " no len)) + 'jao-themes-f02) + (jao--put-face (or title "") 'jao-themes-f00) + (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 tims (if times 'jao-themes-f00 'jao-themes-dimm)))) + "")) (defvar jao-mpc-minibuffer-str "") (defun jao-mpc--set-current-str (&optional port) - (setq jao-mpc-minibuffer-str - (if (jao-mpc--playing-p port) - (jao-mpc--current-str port) - (when (and (null port) jao-random-album-p (not (jao-mpc--current))) - (jao-random-album-next)) - "")) + (let ((status (or (jao-mpc-status port) ""))) + (setq jao-mpc-minibuffer-str + (if (string= "playing" status) (jao-mpc--current-str port) "")) + (when (and jao-random-album-active + (or (string= status "stopped") (string= status "paused")) + (string= "0\n" (jao-mpc--cmd "status %songpos%" port))) + (jao-random-album-next))) (jao-minibuffer-refresh)) (defvar jao-mpc--idle-procs nil) @@ -109,11 +135,13 @@ "idleloop" "player") :filter (lambda (_p _s) (jao-mpc--set-current-str port))))) +(defvar jao-mpc--browser-port nil) + (define-derived-mode jao-mpc-albums-mode fundamental-mode "MPC Albums" "Mode to display the list of albums known by mpd." (read-only-mode -1) (delete-region (point-min) (point-max)) - (insert (jao-mpc--cmd "list album")) + (insert (jao-mpc--cmd "list album" jao-mpc--browser-port)) (goto-char (point-min)) (read-only-mode 1)) @@ -124,12 +152,13 @@ (jao-mpc-albums-mode) (current-buffer)))) -(defun jao-mpc--add-and-play (&optional album) +(defun jao-mpc--add-and-play (&optional album port idp) (interactive) - (let ((album (or album (string-trim (thing-at-point 'line))))) - (jao-mpc--cmd "clear") - (jao-mpc--cmd (format "findadd album \"%s\"" album)) - (jao-mpc--cmd "play"))) + (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 "play" p))) (define-key jao-mpc-albums-mode-map (kbd "n") #'next-line) (define-key jao-mpc-albums-mode-map (kbd "p") #'previous-line) @@ -170,15 +199,22 @@ (let ((jao-mpc-port (or port jao-mpc-port))) (jao-mpc-playlist-mode)) (current-buffer))) +(defun jao-mpc--with-delayed-random-album (cmd port) + (let ((st jao-random-album-active)) + (setq jao-random-album-active nil) + (jao-mpc--cmd cmd port) + (accept-process-output nil 0.5) + (setq jao-random-album-active st))) + ;;;###autoload (defun jao-mpc-stop (&optional port) (interactive) - (jao-mpc--cmd "stop" port)) + (jao-mpc--with-delayed-random-album "stop" port)) ;;;###autoload (defun jao-mpc-toggle (&optional port) (interactive) - (jao-mpc--cmd "toggle" port)) + (jao-mpc--with-delayed-random-album "toggle" port)) ;;;###autoload (defun jao-mpc-play (&optional port) @@ -208,7 +244,12 @@ ;;;###autoload (defun jao-mpc-echo-current (&optional port) (interactive) - (jao-notify (jao-mpc--current-str port))) + (message "%s" (jao-mpc--current-str port t))) + +;;;###autoload +(defun jao-mpc-echo-current-times (&optional port) + (interactive) + (message "Playing time: %s" (jao-mpc--current-timestr t))) ;;;###autoload (defun jao-mpc-add-url (url) @@ -216,9 +257,33 @@ (jao-mpc--cmd (format "add %s" url))) ;;;###autoload -(defun jao-mpc-show-albums () +(defun jao-mpc-add-or-play-url (url &optional play) + "Add the given URL to mpc's playing list, or just play it." + (let ((p (or play (yes-or-no-p (format "Play %s right now?" url))))) + (when p (jao-mpc-clear)) + (jao-mpc-add-url url) + (if p (jao-mpc-play) (message "%s added to mpc queue" url)))) + +(defvar jao-mpc-stream-urls + '(("classic fm" . "http://media-ice.musicradio.com:80/ClassicFMMP3") + ("wcpe" . "http://audio-mp3.ibiblio.org:8000/wcpe.mp3") + ("davide of mimic" . "http://streaming01.zfast.co.uk:8018/stream") + ("cinemix" . "http://94.23.51.96:8000") ;; 209.9.238.4:6022 209.9.238.4:6046 + ("bbc gold" . "http://media-ice.musicradio.com:80/GoldMP3") + ("irish gold" . "http://icecast2.rte.ie/gold"))) + +;;;###autoload +(defun jao-mpc-play-stream () + "Select a predefined stream URL and add or play it in mpc." + (interactive) + (let ((s (completing-read "Stream: " jao-mpc-stream-urls))) + (jao-mpc-add-or-play-url (cdr (assoc s jao-mpc-stream-urls)) t))) + +;;;###autoload +(defun jao-mpc-show-albums (&optional port) "Show album list." (interactive) + (setq jao-mpc--browser-port port) (pop-to-buffer (jao-mpc--album-buffer))) ;;;###autoload @@ -239,7 +304,7 @@ (defun jao-mpc-connect (&optional port) (interactive) (jao-mpc--idle-loop port) - (when (jao-mpc--playing-p port) (jao-mpc--set-current-str port))) + (when (jao-mpc-playing-p port) (jao-mpc--set-current-str port))) ;;;###autoload (defun jao-mpc-setup (&optional secondary-port priority) @@ -248,26 +313,27 @@ #'jao-mpc--add-and-play #'jao-mpc-stop jao-notify-audio-icon) - (jao-mpc-connect) + (let ((jao-random-album-active nil)) (jao-mpc-connect)) (when secondary-port (jao-mpc-connect secondary-port)) (when priority (if (> priority 0) (jao-minibuffer-add-variable 'jao-mpc-minibuffer-str priority) (jao-minibuffer-add-msg-variable 'jao-mpc-minibuffer-str (- priority))))) -(defvar jao-mpc--album-titles nil) (defconst jao-mpc--albums-cmd "-f '%album% - %artist%' find \"(ALBUM =~ '.*')\" | uniq") +(defconst jao-mpc--simple-albums-cmd "list album") ;;;###autoload -(defun jao-mpc-select-album (refresh) - (interactive "P") - (let ((albums (or (and (not refresh) jao-mpc--album-titles) - (setq jao-mpc--album-titles - (split-string (jao-mpc--cmd jao-mpc--albums-cmd) - "\n" t))))) +(defun jao-mpc-select-album (&optional port) + (interactive) + (let* ((albums-str (jao-mpc--cmd jao-mpc--albums-cmd port)) + (albums-str (if (string= "" albums-str) + (jao-mpc--cmd jao-mpc--simple-albums-cmd port) + albums-str)) + (albums (split-string albums-str "\n" t))) (when-let (album (completing-read "Play album: " albums nil t)) - (jao-mpc--add-and-play (car (split-string album "-" t " ")))))) + (jao-mpc--add-and-play (car (split-string album "-" t " ")) port)))) (provide 'jao-mpc) ;;; jao-mpc.el ends here diff --git a/lib/media/jao-mpris.el b/lib/media/jao-mpris.el index 47a35a7..3bb2636 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 jao +;; Copyright (C) 2020, 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: multimedia @@ -119,7 +119,7 @@ (duration (cond (duration duration) ((stringp len) len) ((numberp len) (jao-mpris--fmt-time (/ len 1e6) ""))))) - (format "> %s %s %s%s%s" + (format "%s %s %s%s%s" (jao--put-face (format "%s" (or track "")) 'jao-themes-f00) (jao--put-face (or title "") 'jao-themes-f01) (jao--put-face (or artist "") 'jao-themes-f11) @@ -130,6 +130,7 @@ (defun jao-mpris--track (&optional info) (let ((info (or info (jao-playerctl--status)))) + (setq jao-mpris--current info) (if (string= "Playing" (jao-mpris--get 'status info)) (setq jao-mpris-track-string (jao-mpris--format info)) (setq jao-mpris-track-string ""))) diff --git a/lib/media/jao-random-album.el b/lib/media/jao-random-album.el index 2800115..5b10308 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 -;; Copyright (C) 2009, 2010, 2017, 2018, 2019, 2021 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2017-2019, 2021-2022, 2024 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sat Jul 04, 2009 13:06 @@ -20,10 +20,10 @@ (require 'jao-notify) -(defvar jao-random-album-p t) +(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-p t) +(defvar jao-random-album-notify t) (defvar jao-random-album-notify-icon jao-notify-audio-icon) (defvar jao-random-album-skip-lines 2) @@ -60,19 +60,19 @@ (defun jao-random-album-start () (interactive) - (setq jao-random-album-p t) + (setq jao-random-album-active t) (jao-random-album-next)) (defun jao-random-album-stop () (interactive) - (setq jao-random-album-p nil) + (setq jao-random-album-active nil) (funcall jao-random-album-stop)) (defun jao-random-album-toggle () (interactive) - (setq jao-random-album-p (not jao-random-album-p)) + (setq jao-random-album-active (not jao-random-album-active)) (message "Random album %s" - (if jao-random-album-p "enabled" "disabled"))) + (if jao-random-album-active "enabled" "disabled"))) (defun jao-random-album-next () (interactive) @@ -80,7 +80,7 @@ (jao-goto-random-album) (let ((album (string-trim (thing-at-point 'line)))) (funcall jao-random-album-add-tracks-and-play album) - (when jao-random-album-notify-p + (when jao-random-album-notify (jao-notify album "Next album" jao-random-album-notify-icon))))) (defun jao-random-album-reset () diff --git a/lib/media/jao-spt.el b/lib/media/jao-spt.el index 4484ead..ba5d104 100644 --- a/lib/media/jao-spt.el +++ b/lib/media/jao-spt.el @@ -1,6 +1,6 @@ ;;; jao-spt.el --- Access to the spotify-tui CLI -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022 jao +;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: multimedia @@ -27,7 +27,7 @@ (require 'jao-minibuffer) (require 'jao-notify) -(defvar jao-spt-bin (expand-file-name "~/bin/spt")) +(defvar jao-spt-bin "spt") (defvar jao-spt-format "'%s %t - %a [%r] %f'") (defvar jao-spt-device nil) @@ -48,7 +48,7 @@ st)) (defun jao-spt--pb* (&rest args) - (message (apply 'jao-spt--pb args))) + (message "%s" (apply 'jao-spt--pb args))) ;;;###autoload (defun jao-spt-play-uri (uri) @@ -119,7 +119,7 @@ ;;;###autoload (defun jao-spt-echo-current () (interactive) - (let ((jao-notify-use-messages-p t)) + (let ((jao-notify-use-messages t)) (jao-notify (jao-spt-update-status)))) ;;;###autoload diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el index 9a34656..4ac5447 100644 --- a/lib/net/jao-eww-session.el +++ b/lib/net/jao-eww-session.el @@ -86,7 +86,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (defvar jao-eww-current-session '(jao-eww-session 0 nil)) -(defun jao-eww-session--list-buffers (&optional skip) +(defun jao-eww-session-eww-buffers (&optional skip) (seq-filter (lambda (b) (when (not (eq b skip)) (with-current-buffer b (derived-mode-p 'eww-mode)))) @@ -94,7 +94,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (defun jao-eww-session-invisible-buffers () (seq-filter (lambda (b) (null (get-buffer-window b))) - (jao-eww-session--list-buffers (current-buffer)))) + (jao-eww-session-eww-buffers (current-buffer)))) (defun jao-eww--current-url () (when-let (url (eww-current-url)) (url-encode-url url))) @@ -104,7 +104,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (cb (current-buffer)) (pos 0) (count 0)) - (dolist (b (jao-eww-session--list-buffers (when skip-current cb)) + (dolist (b (jao-eww-session-eww-buffers (when skip-current cb)) (list pos (reverse urls))) (set-buffer b) (when-let (url (jao-eww--current-url)) @@ -141,7 +141,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (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)))))))) - (jao-eww-session--list-buffers))) + (jao-eww-session-eww-buffers))) (defun jao-eww-session-load-aux () (let ((new-session (jao-eww-session-from-file @@ -226,7 +226,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (dolist (url urls) (eww url 4)) (seq-each #'kill-buffer buffers) (unless (zerop offset) - (switch-to-buffer (nth offset (jao-eww-session--list-buffers))))))) + (switch-to-buffer (nth offset (jao-eww-session-eww-buffers))))))) (provide 'jao-eww-session) ;;; jao-eww-session.el ends here diff --git a/lib/net/jao-frm.el b/lib/net/jao-frm.el deleted file mode 100644 index 2658687..0000000 --- a/lib/net/jao-frm.el +++ /dev/null @@ -1,222 +0,0 @@ -;;; jao-frm.el --- use frm to show mailbox - -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2019, 2020 - -;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> -;; Keywords: mail - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Little hack to see the contents of your mailbox using GNU mailutils' -;; `frm' program. -;; -;; Just put (require 'jao-frm) in your .emacs, and M-x jao-frm will pop up a -;; new window with your mailbox contents (from and subject) as -;; printed by frm. In this buffer, use `n' and `p' to move, `q' to close -;; the window. `g' will call Gnus. -;; - -;;; Code: - -;;;; Customisation: - -(defgroup jao-frm nil - "Frm-base mailbox checker" - :group 'mail - :prefix "jao-frm-") - -(defcustom jao-frm-exec-path "frm" - "frm executable path" - :group 'jao-frm - :type 'file) - -(defcustom jao-frm-mail-command 'gnus - "Emacs function to invoke when `g' is pressed on an frm buffer." - :group 'jao-frm - :type 'symbol) - -(defcustom jao-frm-mailboxes nil - "List of mailboxes to check, or directory containing them." - :group 'jao-frm - :type '(choice directory (repeat file))) - -(defface jao-frm-mailno-face '((t (:foreground "dark slate grey"))) - "Face for the mail number." - :group 'jao-frm) - -(defface jao-frm-from-face '((t (:foreground "slate grey"))) - "Face for From: header." - :group 'jao-frm) - -(defface jao-frm-subject-face '((t (:foreground "slate blue"))) - "Face for Subject: header." - :group 'jao-frm) - -(defface jao-frm-mailbox-face '((t (:bold t :weight bold))) - "Face for mailbox name." - :group 'jao-frm) - -;;;; Mode: - -(defvar jao-frm-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (define-key map [?q] 'jao-frm-delete-window) - (define-key map [?n] 'next-line) - (define-key map [?p] 'previous-line) - (define-key map [?r] 'jao-frm) - (define-key map [?g] (lambda () - (interactive) - (funcall jao-frm-mail-command))) - (define-key map [(control k)] 'jao-frm-delete-message) - map)) - -(setq jao-frm-font-lock-keywords - '(("^[^ :]+:" . 'jao-frm-mailbox-face) - ("^\\([ 0-9]+\\):\t+\\([^\t]+\\)\t+\\([^\n]+$\\)" - (1 'jao-frm-mailno-face) - (2 'jao-frm-from-face) - (3 'jao-frm-subject-face)))) - -(defvar jao-frm-mode-syntax-table - (let ((st (make-syntax-table))) - st)) - -(defun jao-frm-mode () - "Major mode for displaying frm output." - (interactive) - (kill-all-local-variables) - (buffer-disable-undo) - (use-local-map jao-frm-mode-map) - (set (make-local-variable 'font-lock-defaults) - '(jao-frm-font-lock-keywords)) - (set (make-local-variable 'truncate-lines) t) - (set (make-local-variable 'kill-whole-line) t) - (set (make-local-variable 'next-line-add-newlines) nil) - (setq major-mode 'jao-frm-mode) - (setq mode-name "frm") - (read-only-mode 1) - (goto-char 1)) - -;;;; Mode commands: -(defvar jao-frm-last-config nil) - -(defun jao-frm-delete-window () - "Delete frm window and restore last win config" - (interactive) - (if (and (consp jao-frm-last-config) - (window-configuration-p (car jao-frm-last-config))) - (progn - (set-window-configuration (car jao-frm-last-config)) - (goto-char (cadr jao-frm-last-config)) - (setq jao-frm-last-config nil)) - (bury-buffer))) - -(defun jao-frm-delete-message () - "Delete message at point" - (interactive) - (when (eq (current-buffer) (get-buffer "*frm*")) - (beginning-of-line) - (when (search-forward-regexp "^ +\\([0-9]+\\):" nil t) - (let ((mn (string-to-number (match-string 1)))) - (when (y-or-n-p (format "Delete message number %d? " mn)) - (read-only-mode -1) - (shell-command (format "echo 'd %d'|mail" mn) t) - (jao-frm) - (when (= (point-max) (point-min)) - (jao-frm-delete-window) - (message "Mailbox is empty"))))))) - -;;;; Activate frm: -(defun jao-frm-mbox-mails (mbox) - (let ((no (ignore-errors - (substring - (shell-command-to-string (format "frm -s n %s|wc -l" mbox)) - 0 -1)))) - (if (stringp no) (string-to-number no) 0))) - -(defun jao-frm-mail-number () - (let ((no 0)) - (dolist (b (jao-frm-mboxes) no) (setq no (+ no (jao-frm-mbox-mails b)))))) - -(defun jao-frm-default-count-formatter (m n) - (format "%s: %s" (file-name-sans-extension (file-name-nondirectory m)) n)) - -(defun jao-frm-mail-counts (fmt) - (let ((fmt (or fmt 'jao-frm-default-count-formatter))) - (remove nil - (mapcar (lambda (m) - (let ((n (jao-frm-mbox-mails m))) - (unless (zerop n) (funcall fmt m n)))) - (jao-frm-mboxes))))) - -(defun jao-frm-display-mailbox (mbox) - (when (not (zerop (jao-frm-mbox-mails mbox))) - (insert (or (file-name-nondirectory mbox) mbox) ":\n\n") - (apply 'call-process - `(,jao-frm-exec-path nil ,(current-buffer) nil - "-s" "n" "-n" "-t" ,@(and mbox (list mbox)))) - (newline 2))) - -(defun jao-frm-mboxes () - (cond ((null jao-frm-mailboxes) (list (getenv "MAIL"))) - ((listp jao-frm-mailboxes) jao-frm-mailboxes) - ((stringp jao-frm-mailboxes) - (if (file-directory-p jao-frm-mailboxes) - (directory-files jao-frm-mailboxes t "^[^.]") - (list jao-frm-mailboxes))) - (t (error "Error in mbox specification. Check `jao-frm-mailboxes'")))) - -;;;###autoload -(defun jao-frm () - "Run frm." - (interactive) - (let ((fbuff (get-buffer-create "*frm*")) - (inhibit-read-only t)) - (if (not (eq fbuff (current-buffer))) - (setq jao-frm-last-config - (list (current-window-configuration) (point-marker)))) - (with-current-buffer fbuff - (delete-region (point-min) (point-max)) - (mapc 'jao-frm-display-mailbox (jao-frm-mboxes)) - (unless (eq major-mode 'jao-frm-mode) - (jao-frm-mode)) - (goto-char (point-min)) - (if (= (point-min) (point-max)) - (message "Mailbox is empty.") - (pop-to-buffer fbuff)) - (when (and (boundp 'display-time-mode) display-time-mode) - (display-time-update))))) - -;;;###autoload -(defun jao-frm-show-mail-numbers (&optional fmt) - (interactive) - (let ((counts (jao-frm-mail-counts fmt))) - (message (if counts (mapconcat 'identity counts ", ") "No mail")))) - -;;;###autoload -(defun jao-frm-mail-string () - (let ((counts (jao-frm-mail-counts - (lambda (m n) - (let ((m (substring (file-name-nondirectory m) 0 1))) - (format "%s%s" (capitalize m) n)))))) - (mapconcat 'identity counts " "))) - -(provide 'jao-frm) - -;;; jao-frm.el ends here diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el deleted file mode 100644 index e18c5a1..0000000 --- a/lib/net/jao-notmuch-gnus.el +++ /dev/null @@ -1,213 +0,0 @@ -;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 jao - -;; Author: jao <mail@jao.io> -;; Keywords: mail - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Helper functions to work in Gnus with mail indexed by notmuch. - -;;; Code: - -(require 'gnus) -(require 'ol-gnus) -(require 'notmuch-show) - - -;;; Tagging in notmuch from Gnus buffers - -(defun jao-notmuch-gnus--notmuch-id (id) - (when id (if (string-match "<\\(.+\\)>" id) (match-string 1 id) id))) - -(defun jao-notmuch-gnus-message-id (&optional no-show) - "Find the id of currently selected message in Gnus or notmuch." - (when (and (not no-show) (derived-mode-p 'gnus-summary-mode)) - (save-window-excursion (gnus-summary-show-article))) - (cond (gnus-original-article-buffer - (with-current-buffer gnus-original-article-buffer - (jao-notmuch-gnus--notmuch-id (message-field-value "message-id")))) - ((derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) - (notmuch-show-get-message-id)))) - -(defun jao-notmuch-gnus-message-tags (id) - "Ask notmuch for the tags of a message with the given ID." - (let ((cmd (format "notmuch search --output=tags 'id:%s'" id))) - (split-string (shell-command-to-string cmd)))) - -(defun jao-notmuch-gnus-tag-message (&optional id tags no-log) - "Interactively add or remove tags to the current message." - (interactive) - (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (unless tags (jao-notmuch-gnus-message-tags id))) - (prompt (format "Change tags %s" (string-join current "/"))) - (tags (or tags (notmuch-read-tag-changes current prompt)))) - (notmuch-tag (concat "id:" id) tags) - (unless no-log - (message "%s -> %s" current (jao-notmuch-gnus-message-tags id))))) - -(defun jao-notmuch-gnus-show-tags () - "Display in the echo area the tags of the current message." - (interactive) - (when-let (id (jao-notmuch-gnus-message-id)) - (message "%s" (string-join (jao-notmuch-gnus-message-tags id) " ")))) - -(defun jao-notmuch-gnus-toggle-tags (tags &optional id current) - "Toggle the given TAGS list for the current Gnus message." - (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (or current (jao-notmuch-gnus-message-tags id))) - (tags (mapcar (lambda (x) - (concat (if (member x current) "-" "+") x)) - tags))) - (notmuch-tag (concat "id:" id) tags) - (message "New tags: %s" (jao-notmuch-gnus-message-tags id)))) - -(defun jao-notmuch-gnus-tag-mark () - "Remove the new tag for an article when it's marked as seen by Gnus." - (when-let (id (jao-notmuch-gnus-message-id t)) - (jao-notmuch-gnus-tag-message id '("-new") t))) - -(add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark) - -(defun jao-notmuch-gnus--group-tags (group) - (when (string-match ".+:\\(.+\\)" group) - (split-string (match-string 1 group) "\\."))) - -(defun jao-notmuch-gnus-tag-on-move (op headers from to _d) - (when-let* ((to-tags (when to (jao-notmuch-gnus--group-tags to))) - (id (jao-notmuch-gnus--notmuch-id (mail-header-id headers)))) - (if (eq op 'delete) - (let ((cur (seq-difference (jao-notmuch-gnus--group-tags from) to-tags))) - (jao-notmuch-gnus-toggle-tags (append cur to-tags) id cur)) - (notmuch-tag (concat "id:" id) - (mapcar (lambda (x) (concat "+" x)) to-tags))))) - -(defun jao-notmuch-gnus-auto-tag () - (add-hook 'gnus-summary-article-move-hook #'jao-notmuch-gnus-tag-on-move) - (add-hook 'gnus-summary-article-expire-hook #'jao-notmuch-gnus-tag-on-move)) - - -;;;; Displaying search results in Gnus - -(defvar jao-notmuch-gnus-server "nnml" - "Name of the target Gnus server, e.g. nnml+mail.") - -(defvar jao-notmuch-gnus-mail-directory (expand-file-name "~/.emacs.d/gnus/Mail") - "Directory where Gnus stores its mail.") - -(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/news") - "Directory where leafnode stores its messages as seen by notmuch.") - -(defun jao-notmuch-gnus-file-to-group (file &optional maildir newsdir) - "Compute the Gnus group name from the given file name. -Example: - - IN: /home/jao/var/mail/jao/foo/cur/1259184569.M4818P3384.localhost,W=6921:2,S - OUT: nnml:jao.foo - - IN: /home/jao/.emacs.d/gnus/Mail/jao.trove/32, /home/jao/.emacs.d/gnus/Mail/ - OUT: nnml:jao.trove - - IN: /home/jao/var/mail/gmane/foo/bar/100 - OUT: nntp:gmane.foo.bar - - IN: /home/jao/var/mail/bigml/cur/1259176906.M17483P24679.localhost,W=2488:2,S - OUT:nnimap:bigml/inbox" - (let* ((maildir (or maildir jao-notmuch-gnus-mail-directory)) - (newsdir (or newsdir jao-notmuch-gnus-leafnode-directory)) - (g (directory-file-name (file-name-directory file))) - (g (replace-regexp-in-string (file-name-as-directory maildir) "" g)) - (g (replace-regexp-in-string (file-name-as-directory newsdir) "" g)) - (nntp (string-match-p "^\\(gmane\\|gwene\\)/" g)) - (g (cond (nntp (concat "nntp:" g)) - ((file-name-directory g) - (replace-regexp-in-string "^\\([^/]+\\)/" - (concat jao-notmuch-gnus-server - ":\\1/") - (file-name-directory g) t)) - (t (concat jao-notmuch-gnus-server ":" g)))) - (g (replace-regexp-in-string "/" "." g)) - (g (replace-regexp-in-string "[/.]$" "" g))) - (cond ((string-match ":$" g) (concat g "inbox")) - (nntp g) - (t (replace-regexp-in-string ":\\." ":" g))))) - -(defun jao-notmuch-gnus-id-to-file (id) - (when id - (let ((cmd (format "notmuch search --output=files %s" id))) - (string-trim (shell-command-to-string cmd))))) - -(defun jao-notmuch-gnus-goto-message (&optional msg-id filename) - "Open a summary buffer containing the current notmuch article." - (interactive) - (let* ((filename (or filename - (jao-notmuch-gnus-id-to-file msg-id) - (notmuch-show-get-filename))) - (group (when filename (jao-notmuch-gnus-file-to-group filename))) - (msg-id (or msg-id (notmuch-show-get-message-id))) - (msg-id (when msg-id (replace-regexp-in-string "^id:" "" msg-id)))) - (if (and group msg-id) - (org-gnus-follow-link group msg-id) - (message "Couldn't get relevant infos for switching to Gnus.")))) - - -;;;; Org links -(defun jao-notmuch-gnus--fname (id) - (let ((cmd (format "notmuch search --output=files id:%s" id))) - (car (split-string (shell-command-to-string cmd))))) - -(defun jao-notmuch-gnus-org-follow (id) - (when-let* ((fname (jao-notmuch-gnus--fname id)) - (group (jao-notmuch-gnus-file-to-group fname))) - (org-gnus-follow-link group id))) - -(defun jao-notmuch-gnus-org-store () - (when-let (d (or (when (derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) - (cons (notmuch-show-get-message-id) - (notmuch-show-get-subject))) - (when (derived-mode-p 'gnus-summary-mode 'gnus-article-mode) - (cons (jao-notmuch-gnus-message-id) - (gnus-summary-article-subject))))) - (org-link-store-props :type "mail" - :link (concat "mail:" (car d)) - :description (concat "Mail: " (cdr d))))) - -(org-link-set-parameters "mail" - :follow #'jao-notmuch-gnus-org-follow - :store #'jao-notmuch-gnus-org-store) - -(org-link-set-parameters "gnus" :store #'ignore) -(org-link-set-parameters "notmuch" :store #'ignore) - - -;;;; consult-notmuch - -(with-eval-after-load "consult-notmuch" - (defun jao-notmuch-gnus--open-candidate (candidate) - "Open a notmuch-search completion candidate email in Gnus." - (message "candidate: %S" candidate) - (jao-notmuch-gnus-goto-message (consult-notmuch--thread-id candidate))) - - (defun jao-gnus-consult-notmuch () - "Run a consult-notmuch query that opens candidates in Gnus." - (interactive) - (jao-notmuch-gnus--open-candidate (consult-notmuch--search))) - - (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) - -(provide 'jao-notmuch-gnus) -;;; jao-notmuch-gnus.el ends here diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el index bd48e8f..aef9757 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 jao +;; Copyright (C) 2021, 2022, 2023, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -18,11 +18,9 @@ ;; 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: +;; Extensions to vanilla notmuch, mostly for tree view -;; Extensions to vanilla notmuch, mostly for tree view - -;;; Code: +;;; require: (require 'outline) (require 'mm-decode) @@ -32,8 +30,8 @@ (require 'notmuch-tree) (require 'notmuch-show) - -;;;; Targetting the displayed message from the tree view + +;;; targetting the displayed message from the tree view (defvar-local jao-notmuch--tree-buffer nil) (declare eww--url-at-point "eww") @@ -54,12 +52,6 @@ (notmuch-tree-close-message-window) (notmuch-tree-show-message nil))) -(defun jao-notmuch-click-message-buffer () - (interactive) - (let ((b (current-buffer))) - (unless (eq 'url (jao-notmuch-goto-message-buffer t t)) - (pop-to-buffer b)))) - (defun jao-notmuch-tree--find-tree-buffer () (or jao-notmuch--tree-buffer (let ((mb (current-buffer))) @@ -87,7 +79,7 @@ (if (not (jao-notmuch-tree--looking-at-message)) (jao-notmuch-tree-show-or-scroll t) (if (notmuch-tree-scroll-message-window) - (jao-notmuch-tree-next nil) + (notmuch-tree-outline-next) (when (not (window-live-p notmuch-tree-message-window)) (notmuch-tree-show-message nil))))) @@ -130,8 +122,8 @@ (completing-read "Browse URL: " urls)) (message "No URLs in this message"))) - -;;;; Navigating URLs + +;;; navigating URLs (require 'ffap) @@ -157,8 +149,8 @@ (thing-at-point-url-at-point))) (browse-url url))) - -;;;; Toggling mime parts and images + +;;; toggling mime parts and images (defun jao-notmuch--toggle-mime () (save-excursion @@ -207,15 +199,20 @@ (defun jao-notmuch-toggle-images () (interactive) - (cond ((eq mm-text-html-renderer 'w3m) - (when (fboundp 'jao-notmuch--w3m-toggle-images) - (jao-notmuch--w3m-toggle-images))) + (cond ((memq mm-text-html-renderer '(w3m jao-w3m-html-renderer)) + (when (fboundp 'jao-notmuch--w3m-toggle-images) + (jao-notmuch--w3m-toggle-images))) (window-system (jao-notmuch--shr-toggle-images)) - (t (with-current-buffer notmuch-tree-message-buffer - (jao-notmuch--view-html))))) + (notmuch-tree-message-buffer + (if nil ;;(fboundp 'jao-open-in-x-frame) + (let ((w (get-buffer-window notmuch-tree-message-buffer))) + (jao-open-in-x-frame (window-width w) (window-height w)) + (jao-notmuch--shr-toggle-images) + (delete-window)) + (with-current-buffer notmuch-tree-message-buffer + (jao-notmuch--view-html)))))) - -;;;; Keeping track of unread messages in current tree view +;;; header line 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))) @@ -224,23 +221,24 @@ (defsubst jao-notmuch-tree--first-p (&optional msg) (plist-get (or msg (notmuch-tree-get-message-properties)) :first)) -(defun jao-notmuch--message-counts (&optional thread) - (let ((cnt) (total 0) (match 0) (msg)) - (save-excursion - (if thread - (while (and (not (jao-notmuch-tree--first-p)) - (zerop (forward-line -1)))) - (goto-char (point-min))) - (while (and (setq msg (notmuch-tree-get-message-properties)) - (or (not cnt) - (not thread) - (not (jao-notmuch-tree--first-p msg)))) - (unless cnt (setq cnt 0)) - (setq total (1+ total)) - (when (plist-get msg :match) (setq match (1+ match))) - (when (jao-notmuch--looking-at-new-p msg) (setq cnt (1+ cnt))) - (forward-line 1))) - (when cnt (list total match cnt)))) +(defun jao-notmuch--message-counts (tree-buffer &optional thread) + (with-current-buffer tree-buffer + (let ((cnt) (total 0) (match 0) (msg)) + (save-excursion + (if thread + (while (and (not (jao-notmuch-tree--first-p)) + (zerop (forward-line -1)))) + (goto-char (point-min))) + (while (and (setq msg (notmuch-tree-get-message-properties)) + (or (not cnt) + (not thread) + (not (jao-notmuch-tree--first-p msg)))) + (unless cnt (setq cnt 0)) + (setq total (1+ total)) + (when (plist-get msg :match) (setq match (1+ match))) + (when (jao-notmuch--looking-at-new-p msg) (setq cnt (1+ cnt))) + (forward-line 1))) + (when cnt (list total match cnt))))) (defvar jao-notmuch-header-line-format "%Q [%N / %M / %T] %n / %m / %t") @@ -249,186 +247,149 @@ `((?Q . ,query) (?T . ,total) (?N . ,new) (?M . ,match) (?t . ,ttotal) (?n . ,tnew) (?m . ,tmatch)))) -(defun jao-notmuch--update-header-line (mb) - (let* ((n (or (jao-notmuch--message-counts) '(0 0 0))) - (nc (append n (or (jao-notmuch--message-counts t) '(0 0 0)))) - (q (buffer-name))) - (with-current-buffer mb +(defun jao-notmuch--format-header-line (tree-buffer buffer subject) + (let* ((n (jao-notmuch--message-counts tree-buffer)) + (nc (jao-notmuch--message-counts tree-buffer t))) + (with-current-buffer buffer (when (derived-mode-p 'notmuch-show-mode) - (let* ((s (thread-last (notmuch-show-get-subject) - (notmuch-show-strip-re) - (notmuch-sanitize))) + (let* ((nc (append (or n '(0 0 0)) (or nc '(0 0 0)))) + (q (if (string= tree-buffer subject) "" tree-buffer)) (c (apply 'jao-notmuch--format-counts q nc)) - (n (- (window-width) 3 (string-width s) (string-width c))) - (s (if (< n 0) (substring s 0 (- n 4)) s)) - (n (if (< n 0) 5 (1+ n)))) - (setq-local header-line-format - (concat " " s (make-string n ? ) c))))))) - -(defun jao-notmuch-tree--find-update-header-line (&rest _args) - (when-let ((mb (if (derived-mode-p 'notmuch-show-mode) - (current-buffer) - (window-buffer notmuch-tree-message-window)))) - (seq-find (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'notmuch-tree-mode) - (or (null notmuch-tree-message-buffer) - (eq notmuch-tree-message-buffer mb)) - (jao-notmuch--update-header-line mb)))) - (buffer-list)))) - -(add-hook 'notmuch-after-tag-hook #'jao-notmuch-tree--find-update-header-line) -(add-hook 'notmuch-show-hook #'jao-notmuch-tree--find-update-header-line) - - -;;;; Outline mode for tree view - -(defun jao-notmuch-tree--msg-prefix (msg) - (insert (propertize (if (plist-get msg :first) "> " " ") 'display " "))) - -(defun jao-notmuch-tree--mode-setup () - (setq-local outline-regexp "^> \\|^En") - (outline-minor-mode t)) - -(defun jao-notmuch-tree-hide-others (&optional and-show) - (interactive) - (outline-hide-body) - (outline-show-entry) - (when and-show (notmuch-tree-show-message nil))) - -(defun jao-notmuch-tree--next (prev thread no-exit &optional ignore-new) - (let ((line-move-ignore-invisible nil)) - (cond ((and (not ignore-new) (jao-notmuch--looking-at-new-p))) - (thread - (notmuch-tree-next-thread prev) - (unless (or (not (notmuch-tree-get-message-properties)) - (jao-notmuch--looking-at-new-p)) - (notmuch-tree-matching-message prev (not no-exit)))) - (t (notmuch-tree-matching-message prev (not no-exit))))) - (when (notmuch-tree-get-message-id) - (jao-notmuch-tree-hide-others t)) - (when prev (forward-char 2))) - -(defvar jao-notmuch-tree--prefix-map - (let ((m (make-keymap "Thread operations"))) - (define-key m (kbd "TAB") #'outline-cycle) - (define-key m (kbd "t") #'outline-toggle-children) - (define-key m (kbd "s") #'outline-show-entry) - (define-key m (kbd "S") #'outline-show-all) - (define-key m (kbd "h") #'outline-hide-entry) - (define-key m (kbd "H") #'outline-hide-body) - (define-key m (kbd "o") #'jao-notmuch-tree-hide-others) - (define-key m (kbd "n") #'outline-hide-other) - m)) - -(defun jao-notmuch-tree-outline-setup (&optional prefix) - (define-key notmuch-tree-mode-map (kbd (or prefix "T")) - jao-notmuch-tree--prefix-map) - (define-key notmuch-tree-mode-map (kbd "TAB") #'outline-cycle) - (define-key notmuch-tree-mode-map (kbd "M-TAB") #'outline-cycle-buffer) - (add-hook 'notmuch-tree-mode-hook #'jao-notmuch-tree--mode-setup) - (advice-add 'notmuch-tree-insert-msg :before #'jao-notmuch-tree--msg-prefix)) - -(defun jao-notmuch-tree-next (thread &optional no-exit) - "Next message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next nil thread no-exit)) + (n (- (window-width) 2 (string-width subject) (string-width c))) + (subject (if (< n 0) (substring subject 0 n) subject)) + (n (if (< n 0) 2 (+ n 2)))) + (concat (when window-system " ") subject (make-string n ? ) c)))))) -(defun jao-notmuch-tree-next-thread (&optional exit) - "Next thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next nil t exit)) +(defun jao-notmuch-message-header-line (subject) + (if-let* ((cb (buffer-name (current-buffer))) + (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))) + (concat " " subject))) -(defun jao-notmuch-tree-previous (thread) - "Previous message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next t thread t)) +(defun jao-notmuch--format-lighter () + (when (derived-mode-p 'notmuch-tree-mode) + (let* ((n (jao-notmuch--message-counts (current-buffer))) + (nc (jao-notmuch--message-counts (current-buffer) t)) + (nc (append (or n '(0 0 0)) (or nc '(0 0 0))))) + (apply 'jao-notmuch--format-counts "" nc)))) -(defun jao-notmuch-tree-previous-thread (&optional exit) - "Previous thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next t t exit)) - - -;;;; Updating the tree window after insertion - -(defun jao-notmuch--tree-sentinel (proc &rest _) - (when (eq (process-status proc) 'exit) - (jao-notmuch-tree-hide-others))) +(define-minor-mode jao-notmuch-thread-info-mode "" + :lighter (:eval (format " %s" (jao-notmuch--format-lighter)))) -(defun jao-notmuch-tree-setup (&optional prefix) - "Set up display of trees, with PREFIX key for outline commands." - (jao-notmuch-tree-outline-setup prefix) - (advice-add 'notmuch-tree-process-sentinel :after #'jao-notmuch--tree-sentinel)) - -;;;; Tagging +;;; tagging (defsubst jao-notmuch--has-tag (tag) (member tag (notmuch-tree-get-tags))) -(defun jao-notmuch-tag-jump-and-next (reverse) - (interactive "P") - (notmuch-tag-jump reverse) - (jao-notmuch-tree-next nil t)) - -(defun jao-notmuch-tree--tag (tags reverse whole-thread) +(defun jao-notmuch-tree--tag (tags reverse) (let ((c (notmuch-tag-change-list tags reverse))) - (if whole-thread (notmuch-tree-tag-thread c) (notmuch-tree-tag c)))) - -(defun jao-notmuch-tree--tag-and-next (tags reverse whole-thread) - (jao-notmuch-tree--tag tags reverse whole-thread) - (jao-notmuch-tree-next whole-thread t)) + (notmuch-tree-tag c))) + +(defun jao-notmuch-tree-tag-thread (tags reverse full) + (when full (notmuch-tree-thread-top)) + (let ((c (notmuch-tag-change-list tags reverse)) + (level (or (notmuch-tree-get-prop :level) 0)) + (go t)) + (while go + (notmuch-tree-tag c) + (forward-line) + (setq go (> (or (notmuch-tree-get-prop :level) 0) level))) + (when notmuch-tree-outline-mode + (ignore-errors (outline-show-branches)) + (notmuch-tree-outline-next)))) + +(defun jao-notmuch-tree--tag-and-next (tags reverse) + (jao-notmuch-tree--tag tags reverse) + (notmuch-tree-outline-next t)) (defun jao-notmuch-tree-toggle-delete () (interactive) (let ((undo (jao-notmuch--has-tag "deleted"))) - (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo nil))) + (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo))) -(defun jao-notmuch-tree-toggle-delete-thread () - (interactive) +(defun jao-notmuch-tree-toggle-delete-thread (full) + (interactive "P") (let ((undo (jao-notmuch--has-tag "deleted"))) - (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo t))) + (jao-notmuch-tree-tag-thread '("+deleted" "-new" "-unread") undo full))) -(defun jao-notmuch-tree-read-thread (unread) +(defun jao-notmuch-tree-read-thread (full) (interactive "P") - (jao-notmuch-tree--tag-and-next '("-unread" "-new") unread t)) + (jao-notmuch-tree-tag-thread '("-unread" "-new") nil full)) (defun jao-notmuch-tree-toggle-flag () (interactive) (let ((tags (if (jao-notmuch--has-tag "flagged") '("-flagged") '("-unread" "-new" "-deleted" "+flagged")))) - (jao-notmuch-tree--tag-and-next tags nil nil))) + (jao-notmuch-tree--tag-and-next tags nil))) (defun jao-notmuch-tree-toggle-spam () (interactive) (let ((tags (if (jao-notmuch--has-tag "spam") '("-spam") '("-unread" "-new" "+spam")))) - (jao-notmuch-tree--tag-and-next tags nil nil))) + (jao-notmuch-tree--tag-and-next tags nil))) (defun jao-notmuch-tree-reset-tags () (interactive) (let ((tags (plist-get (notmuch-tree-get-message-properties) :orig-tags))) - (jao-notmuch-tree--tag tags nil nil) - (jao-notmuch-tree--next nil nil t t))) - - -;;;; Results formatters + (jao-notmuch-tree--tag tags nil))) + +;;; 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))))) + +(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"))) + (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) + (fcc (concat dest " " tagstr " -new +sent +trove")) + (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)))) + (apply fun args))) + +(advice-add 'notmuch-mua-new-reply :around #'jao-notmuch-mua-new-reply) + +;;; results formatters + +(defun jao-notmuch-cmp-tags (a b) + (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-by #'length #'<) + (seq-sort #'jao-notmuch-cmp-tags)))) (format-spec fmt `((?s . ,(mapconcat #'identity ts " ")))))) -(defun jao-notmuch-tree-and-subject (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))) (format-spec fmt `((?s . ,(concat tr sb)))))) -(defun jao-notmuch-msg-ticks (mails-rx msg) +(defun jao-notmuch-format-msg-ticks (mails-rx msg) (let ((headers (plist-get msg :headers))) (cond ((string-match-p mails-rx (or (plist-get headers :To) "")) (propertize " »" 'face 'notmuch-tree-match-tree-face)) diff --git a/lib/net/jao-proton-utils.el b/lib/net/jao-proton-utils.el new file mode 100644 index 0000000..62b97b3 --- /dev/null +++ b/lib/net/jao-proton-utils.el @@ -0,0 +1,141 @@ +;; 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/signel.org b/lib/net/signel.org deleted file mode 100644 index 722069c..0000000 --- a/lib/net/signel.org +++ /dev/null @@ -1,546 +0,0 @@ -#+title: signel, a barebones signal chat on top of signal-cli -#+date: <2020-02-23 05:03> -#+filetags: emacs norss -#+PROPERTY: header-args :tangle yes :comments yes :results silent - -Unlike most chat systems in common use, [[https://signal.org][Signal]] lacks a decent emacs -client. All i could find was [[https://github.com/mrkrd/signal-msg][signal-msg]], which is able only to send -messages and has a readme that explicitly warns that its is /not/ a chat -application. Skimming over signal-msg's code i learnt about -[[https://github.com/AsamK/signal-cli][signal-cli]], a java-based daemon that knows how to send and receive -signal messages, and how to link to a nearby phone, or register new -users. And playing with it i saw that it can output its activities -formatted as JSON, and that offers (when run in daemon mode) a DBUS -service that can be used to send messages. - -Now, emacs knows how to run a process and capture its output handling -it to a filter function, and comes equipped with a JSON parser and -a set of built-in functions to talk to DBUS buses. - -So how about writing a simple Signal chat app for emacs? Let's call it -/signel/, and write it as [[https://gitlab.com/jaor/elibs/-/blob/master/net/signel.org][a blog post in literate org-mode]]. - -* Starting a process - -We are going to need a variable for our identity (telephone number), -and a list of contact names (until i discover how to get them directly -from signal-cli): - -#+begin_src emacs-lisp -(require 'cl-lib) - -(defvar signel-cli-user "+44744xxxxxx") -(defvar signel-contact-names '(("+447xxxxxxxx" . "john") - ("+346xxxxxxxx" . "anna"))) -#+end_src - -and a simple function to get a contact name given its telephone -number: - -#+begin_src emacs-lisp -(defun signel--contact-name (src) - (or (alist-get src signel-contact-names nil nil #'string-equal) src)) -#+end_src - -We are also going to need the path for our signal-cli executable - -#+begin_src emacs-lisp -(defvar signel-cli-exec "signal-cli") -#+end_src - -Starting the signal-cli process is easy: ~make-process~ provides all the -necessary bits. What we need is essentially calling - -#+begin_src shell -signal-cli -u +44744xxxxxx daemon --json -#+end_src - -associating to the process a buffer selected by the function -~signel--proc-buffer~ . While we are at it, we'll write also little -helpers for users of our API. - -#+begin_src emacs-lisp -(defun signel--proc-buffer () - (get-buffer-create "*signal-cli*")) - -(defun signel-signal-cli-buffer () - (get-buffer "*signal-cli*")) - -(defun signel-signal-cli-process () - (when-let ((proc (get-buffer-process (signel-signal-cli-buffer)))) - (and (process-live-p proc) proc))) -#+end_src - -#+begin_src emacs-lisp -(defun signel-start () - "Start the underlying signal-cli process if needed." - (interactive) - (if (signel-signal-cli-process) - (message "signal-cli is already running!") - (let ((b (signel--proc-buffer))) - (make-process :name "signal-cli" - :buffer b - :command `(,signel-cli-exec - "-u" - ,signel-cli-user - "daemon" "--json") - :filter #'signel--filter) - (message "Listening to signals!")))) -#+end_src - -* Parsing JSON - -We've told emacs to handle any ouput of the process to the function -~signel--filter~, which we're going to write next. This function will -receive the process object and its latest output as a string -representing a JSON object. Here's an example of the kind of outputs -that signal-cli emits: - -#+begin_src json :tangle no -{ - "envelope": { - "source": "+4473xxxxxxxx", - "sourceDevice": 1, - "relay": null, - "timestamp": 1582396178696, - "isReceipt": false, - "dataMessage": { - "timestamp": 1582396178696, - "message": "Hello there!", - "expiresInSeconds": 0, - "attachments": [], - "groupInfo": null - }, - "syncMessage": null, - "callMessage": null, - "receiptMessage": null - } -} -#+end_src - -Everything seems to be always inside ~envelope~, which contains objects -for the possible messages received. In the example above, we're -receiving a message from a /source/ contact. We can also receive -receipt messages, telling us whether our last message has been -received or read; e.g.: - -#+begin_src json :tangle no -{ - "envelope": { - "source": "+4473xxxxxxxx", - "sourceDevice": 1, - "relay": null, - "timestamp": 1582397117584, - "isReceipt": false, - "dataMessage": null, - "syncMessage": null, - "callMessage": null, - "receiptMessage": { - "when": 1582397117584, - "isDelivery": true, - "isRead": false, - "timestamps": [ - 1582397111524 - ] - } - } -} -#+end_src - -A bit confusingly, that delivery notification has a ~receiptMessage~, -but its ~isReceipt~ flag is set to ~false~. At other times, we get -~isReceipt~ but no ~receiptMessage~: - -#+begin_src json :tangle no -{ - "envelope": { - "source": "+346xxxxxxxx", - "sourceDevice": 1, - "relay": null, - "timestamp": 1582476539281, - "isReceipt": true, - "dataMessage": null, - "syncMessage": null, - "callMessage": null, - "receiptMessage": null - } -} -#+end_src - -It is very easy to parse JSON in emacs and extract signal-cli's -envelopes (and it's become faster in emacs 27, but the interface is a -bit different): - -#+begin_src emacs-lisp -(defun signel--parse-json (str) - (if (> emacs-major-version 26) - (json-parse-string str - :null-object nil - :false-object nil - :object-type 'alist - :array-type 'list) - (json-read-from-string str))) - -(defun signel--msg-contents (str) - (alist-get 'envelope (ignore-errors (signel--parse-json str)))) -#+end_src - -Here i am being old-school and opting to receive JSON dicitionaries as -alists (rather than hash maps, the default), and arrays as lists -rather than vectors just because lisps are lisps for a reason. I'm -also going to do some mild [[https://lispcast.com/nil-punning/][nil punning]], -hence the choice for null and false representations. - -Once the contents of the envelope is extracted, it's trivial (and -boring) to get into its components: - -#+begin_src emacs-lisp -(defun signel--msg-source (msg) (alist-get 'source msg)) - -(defun signel--msg-data (msg) - (alist-get 'message (alist-get 'dataMessage msg))) - -(defun signel--msg-timestamp (msg) - (if-let (msecs (alist-get 'timestamp msg)) - (format-time-string "%H:%M" (/ msecs 1000)) - "")) - -;; emacs 26 compat -(defun signel--not-false (x) - (and (not (eq :json-false x)) x)) - -(defun signel--msg-receipt (msg) - (alist-get 'receiptMessage msg)) - -(defun signel--msg-is-receipt (msg) - (signel--not-false (alist-get 'isReceipt msg))) - -(defun signel--msg-receipt-timestamp (msg) - (when-let (msecs (alist-get 'when (signel--msg-receipt msg))) - (format-time-string "%H:%M" (/ msecs 1000)))) - -(defun signel--msg-is-delivery (msg) - (when-let ((receipt (signel--msg-receipt msg))) - (signel--not-false (alist-get 'isDelivery msg)))) - -(defun signel--msg-is-read (msg) - (when-let ((receipt (signel--msg-receipt msg))) - (signel--not-false (alist-get 'isRead msg)))) -#+end_src - -* A process output filter - -We're almost ready to write our filter. It will: - -- For debugging purposes, insert the raw JSON string in the process - buffer. -- Parse the received JSON string and extract its envelope contents. -- Check wether it has a source and either message data or a receipt - timestamp. -- Dispatch to a helper function that will insert the data or - notification in a chat buffer. - -Or, in elisp: - -#+begin_src emacs-lisp -(defvar signel--line-buffer "") - -(defun signel--filter (proc str) - (signel--ordinary-insertion-filter proc str) - (let ((str (concat signel--line-buffer str))) - (if-let ((msg (signel--msg-contents str))) - (let ((source (signel--msg-source msg)) - (stamp (signel--msg-timestamp msg)) - (data (signel--msg-data msg)) - (rec-stamp (signel--msg-receipt-timestamp msg))) - (setq signel--line-buffer "") - (when source - (signel--update-chat-buffer source data stamp rec-stamp msg))) - (setq signel--line-buffer - (if (string-match-p ".*\n$" str) "" str))))) -#+end_src - -We've had to take care of the case when the filter receives input that -is not a complete JSON expression: in the case of signal-cli, that -only happens when we haven't seen yet an end of line. - -The function to insert the raw contents in the process buffer is -surprisingly hard to get right, but the emacs manual spells out a -reasonable implementation, which i just copied: - -#+begin_src emacs-lisp -(defun signel--ordinary-insertion-filter (proc string) - (when (and proc (buffer-live-p (process-buffer proc))) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - ;; Insert the text, advancing the process marker. - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc))))))) -#+end_src - -* It's not an emacs app if it doesn't have a new mode - -With that out of the way, we just have to insert our data in an -appropriate buffer. We are going to associate a separate buffer to -each /source/, using for that its name: - -#+begin_src emacs-lisp -(defvar-local signel-user nil) - -(defun signel--contact-buffer (source) - (let* ((name (format "*%s" (signel--contact-name source))) - (buffer (get-buffer name))) - (unless buffer - (setq buffer (get-buffer-create name)) - (with-current-buffer buffer - (signel-chat-mode) - (setq-local signel-user source) - (insert signel-prompt))) - buffer)) -#+end_src - -where, as is often the case in emacs, we are going to have a dedicated -major mode for chat buffers, called ~signel-chat-mode~. For now, let's -keep it really simple (for the record, this is essentially a copy of -what ERC does for its erc-mode): - -#+begin_src emacs-lisp -(defvar signel-prompt ": ") - -(define-derived-mode signel-chat-mode fundamental-mode "Signal" - "Major mode for Signal chats." - (when (boundp 'next-line-add-newlines) - (set (make-local-variable 'next-line-add-newlines) nil)) - (setq line-move-ignore-invisible t) - (set (make-local-variable 'paragraph-separate) - (concat "\C-l\\|\\(^" (regexp-quote signel-prompt) "\\)")) - (set (make-local-variable 'paragraph-start) - (concat "\\(" (regexp-quote signel-prompt) "\\)")) - (setq-local completion-ignore-case t)) -#+end_src - -Note how, in ~signel--contact-buffer~, we're storing the user identity -associated with the buffer (its /source/) in a buffer-local variable -named ~signel-user~ that is set /after/ enabling ~signel-chat-mode~: order -here matters because the major mode activation cleans up the values of -any local variables previously set (i always forget that!). - -* And a customization group - -We're going to need a couple of new faces for the different parts of -inserted messages, so we'll take the chance to be tidy and introduce a -customization group: - -#+begin_src emacs-lisp -(defgroup signel nil "Signel") - -(defface signel-contact '((t :weight bold)) - "Face for contact names." - :group 'signel) - -(defface signel-timestamp '((t :foreground "grey70")) - "Face for timestamp names." - :group 'signel) - -(defface signel-notice '((t :inherit signel-timestamp)) - "Face for delivery notices." - :group 'signel) - -(defface signel-prompt '((t :weight bold)) - "Face for the input prompt marker." - :group 'signel) - -(defface signel-user '((t :foreground "orangered")) - "Face for sent messages." - :group 'signel) - -(defface signel-notification '((t :foreground "burlywood")) - "Face for notifications shown by tracking, when available." - :group 'signel) - -#+end_src - - -* Displaying incoming messages - -We have now almost all the ingredients to write -~signel--update-chat-buffer~, the function that inserts the received -message data into the chat buffer. Let's define a few little -functions to format those parts: - -#+begin_src emacs-lisp -(defun signel--contact (name) - (propertize name 'face 'signel-contact)) - -(defun signel--timestamp (&rest p) - (propertize (apply #'concat p) 'face 'signel-timestamp)) - -(defun signel--notice (notice) - (propertize notice 'face 'signel-notice)) - -(defun signel--insert-prompt () - (let ((inhibit-read-only t) - (p (point))) - (insert signel-prompt) - (set-text-properties p (- (point) 1) - '(face signel-prompt - read-only t front-sticky t rear-sticky t)))) - -(defun signel--delete-prompt () - (when (looking-at-p (regexp-quote signel-prompt)) - (let ((inhibit-read-only t)) - (delete-char (length signel-prompt))))) - -(defun signel--delete-last-prompt () - (goto-char (point-max)) - (when (re-search-backward (concat "^" (regexp-quote signel-prompt))) - (signel--delete-prompt))) - -#+end_src - -With that, we're finally ready to insert messages in our signel chat -buffers: - -#+begin_src emacs-lisp -(defcustom signel-report-deliveries nil - "Whether to show message delivery notices." - :group 'signel - :type 'boolean) - -(defcustom signel-report-read t - "Whether to show message read notices." - :group 'signel - :type 'boolean) - -(defun signel--prompt-and-notify () - (signel--insert-prompt) - (when (fboundp 'tracking-add-buffer) - (tracking-add-buffer (current-buffer) '(signel-notification)))) - -(defun signel--needs-insert-p (data stamp rec-stamp msg) - (or data - (and (or rec-stamp stamp) - (not (string= source signel-cli-user)) - (or signel-report-deliveries - (and signel-report-read (signel--msg-is-read msg)))))) - -(defun signel--update-chat-buffer (source data stamp rec-stamp msg) - (when (signel--needs-insert-p data stamp rec-stamp msg) - (when-let ((b (signel--contact-buffer source))) - (with-current-buffer b - (signel--delete-last-prompt) - (if data - (let ((p (point))) - (insert (signel--timestamp "[" stamp "] ") - (signel--contact (signel--contact-name source)) - signel-prompt - data - "\n") - (fill-region p (point))) - (let ((is-read (signel--msg-is-read msg))) - (insert (signel--timestamp "*" (or rec-stamp stamp) "* ") - (signel--notice (if is-read "(read)" "(delivered)")) - "\n"))) - (signel--prompt-and-notify) - (end-of-line))))) -#+end_src - -There are some rough edges in the above implementation that must be -polished should signel ever be released in the wild. For one, proper -handling of timestamps and their formats. And of course notifications -should be much more customizable (here i'm using [[https://github.com/jorgenschaefer/circe/blob/master/tracking.el][Circe's tracking.el]] -if available). - -* Sending messages: the DBUS interface - -With that, we're going to receive and display messages and simple -receipts, and i'm sure that we will feel the urge to answer some of -them. As mentioned above, signal-cli let's us send messages via its -[[https://github.com/AsamK/signal-cli/wiki/DBus-service][DBUS interface]]. -In a nutshell, if you want to send ~MESSAGETEXT~ to a -~RECIPIENT~ you'd invoke something like: - -#+begin_src shell :tangle no -dbus-send --session --type=method_call \ - --dest="org.asamk.Signal" \ - /org/asamk/Signal \ - org.asamk.Signal.sendMessage \ - string:MESSAGETEXT array:string: string:RECIPIENT -#+end_src - -That is, call the method ~sendMessage~ of the corresponding service -interface with three arguments (the second one empty). Using emacs' -dbus libray one can write the above as: - -#+begin_src emacs-lisp -(defun signel--send-message (user msg) - (dbus-call-method :session "org.asamk.Signal" "/org/asamk/Signal" - "org.asamk.Signal" "sendMessage" - :string msg - '(:array) - :string user)) -#+end_src - -The only complicated bit is being careful with the specification of -the types of the method arguments: if one gets them wrong, DBUS will -simply complain and say that the method is not defined, which was -confusing me at first (but of course makes sense because DBUS allows -overloading method names, so the full method spec must include its -signature). - -We want to read whatever our user writes after the last prompt and -send it via the little helper above. Here's our interactive command -for that: - -#+begin_src emacs-lisp -(defun signel-send () - "Read text inserted in the current buffer after the last prompt and send it. - -The recipient of the message is looked up in a local variable set -when the buffer was created." - (interactive) - (goto-char (point-max)) - (beginning-of-line) - (let* ((p (point)) - (plen (length signel-prompt)) - (msg (buffer-substring (+ p plen) (point-max)))) - (signel--delete-prompt) - (signel--send-message signel-user msg) - (insert (signel--timestamp (format-time-string "(%H:%M) "))) - (fill-region p (point-max)) - (goto-char (point-max)) - (set-text-properties p (point) '(face signel-user)) - (insert "\n") - (signel--insert-prompt))) -#+end_src - -and we can bind it to the return key in signal chat buffers: - -#+begin_src emacs-lisp -(define-key signel-chat-mode-map "\C-m" #'signel-send) -#+end_src - -And we are going sometimes to want to talk to contacts that don't have -yet said anything and have, therefore, no associated chat buffer: - -#+begin_src emacs-lisp -(defun signel-query (contact) - "Start a conversation with a signal contact." - (interactive (list (completing-read "Signal to: " - (mapcar #'cdr-safe signel-contact-names)))) - (let ((phone (alist-get contact - (cl-pairlis (mapcar #'cdr signel-contact-names) - (mapcar #'car signel-contact-names)) - nil nil #'string-equal))) - (when (not phone) - (error "Unknown contact %s" contact)) - (pop-to-buffer (signel--contact-buffer phone)))) -#+end_src - -There are of course lots of rough edges and missing functionality in -this incipient signel, but it's already usable and a nice -demonstration of how easy it is to get the ball rolling in this lisp -machine of ours! diff --git a/lib/skels/jao-skel-haskell.el b/lib/skels/jao-skel-haskell.el index 01a9936..0c3c17d 100644 --- a/lib/skels/jao-skel-haskell.el +++ b/lib/skels/jao-skel-haskell.el @@ -1,4 +1,5 @@ -;;; jao-skel-haskell.el --- skeleton for haskell source files -*- lexical-binding: t; -*- +;; jao-skel-haskell.el --- skeleton for haskell -*- lexical-binding: t; -*- + ;; Copyright (C) 2003, 2004, 2005, 2009, 2010, 2012, 2022 Jose A Ortega Ruiz ;; Author: Jose A Ortega Ruiz <jao@member.fsf.org> @@ -19,31 +20,23 @@ ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Commentary: - -;; - ;;; Code: (require 'jao-skel) (require 'jao-compilation) +(require 'haskell-mode nil t) -;;; Auxiliar -(defun jao-skel--read-haskell-module () - (let* ((ddir (jao-compilation-root)) - (mbase (and ddir (concat (replace-regexp-in-string "/" "." ddir) - "."))) - (m (read-string "Module prefix (empty for no module): " - (concat (or mbase "") (jao-skel-basename))))) - (or m ""))) +(defun jao-skel-haskell--guess-module () + (if (fboundp 'haskell-guess-module-name) + (haskell-guess-module-name) + (read-string "Module: " (jao-skel-basename)))) (defconst jao-skel--haskell-line (make-string 78 ?-)) -;;; Skeletons (define-skeleton jao-skel-haskell-file "Haskell hs file header" "Brief description: " - '(setq v (jao-skel--read-haskell-module)) + '(setq v (jao-skel-haskell--guess-module)) jao-skel--haskell-line \n "-- |" \n "-- Module: " v \n @@ -63,7 +56,6 @@ "module " v " where " \n \n \n) (jao-skel-install "\\.hs\\'" 'jao-skel-haskell-file) -;; (jao-skel-install "\\.lhs\\'" 'jao-skel-lit-haskell-file) (provide 'jao-skel-haskell) diff --git a/lib/themes/jao-light-term-theme.el b/lib/themes/jao-light-term-theme.el new file mode 100644 index 0000000..ccd6a3f --- /dev/null +++ b/lib/themes/jao-light-term-theme.el @@ -0,0 +1,121 @@ +;;; 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 index bd3fcdf..a172f84 100644 --- a/lib/themes/jao-light-theme.el +++ b/lib/themes/jao-light-theme.el @@ -16,8 +16,6 @@ ;; 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-light-bold (if (> emacs-major-version 28) 'medium 'semibold)) - (jao-define-custom-theme jao-light (:names (bg-lightest "gray98") (bg-light "gray95") @@ -31,21 +29,22 @@ (hl "#f2f2f2") (dimm "lemonchiffon4") - (search "#e8e800") - (search2 "#ffffb4") - (warning "orange4") (red "burlywood4") (blue "#023770") - (green "#005555")) + (pale-blue "honeydew3") + (green "#005555") + (lightgreen "darkgreen") + (yellow "lightyellow")) (:face-size 9) - (:face-family "Fira Code") - (:bold-weight jao-theme-light-bold) + ;; (:face-family "DejaVu Sans Mono") + (:face-family "Hack") + (:bold-weight 'semibold) (:palette (fg "black") (bg "white") (box "gray80") - (button (c fg-light bg-lightest) (ul light-gray)) (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)) @@ -81,9 +80,12 @@ (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" pale-blue)) - (diff-hl-insert (c "white" "honeydew2")) + (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)) @@ -96,16 +98,17 @@ (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-context-highlight (c nil yellow) ex) (magit-diff-hunk-heading-highlight (c nil hl) it bf) - (mode-line (c "grey30" bg-light) - :box (:line-width -1 :color "grey90")) - (mode-line-inactive (c "grey40" "white") - :box (:line-width -1 :color "grey90")) - (mode-line-buffer-id (~ default) (c dark-blue-2 nil) nit) + (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)) @@ -113,6 +116,7 @@ (shr-code (c blue nil)) (success (c green)) (vertical-border (c "grey70" nil)) + (vterm-color-yellow (c "darkgoldenrod4" yellow)) (widget-button (~ default) nit (ul "grey80")))) ;; (enable-theme 'jao-light) diff --git a/lib/themes/jao-themes.el b/lib/themes/jao-themes.el index 2c182f6..b1aa265 100644 --- a/lib/themes/jao-themes.el +++ b/lib/themes/jao-themes.el @@ -21,8 +21,8 @@ (require 'ansi-color) ;;; palette -(defvar jao-themes-default-face "Hack-9") -(defvar jao-themes--face-family "Hack") +(defvar jao-themes-default-face "DejaVu Sans Mono-9") +(defvar jao-themes--face-family "DejaVu Sans Mono") (defvar jao-themes--fg "black") (defvar jao-themes--bg "white") (defvar jao-themes--box "grey75") @@ -191,6 +191,8 @@ (nth clr jao-themes--default-cidxs) (format "color-%s" clr))) ((and (symbolp clr) (cadr (assoc clr *jao-themes--color-names*)))) + ((equal clr 'dfg) jao-themes--fg) + ((equal clr 'dbg) jao-themes--bg) (t 'unspecified))) (defun jao-themes--parse-face-sym (s) @@ -300,7 +302,8 @@ (jao-themes-f10 (p f10)) (jao-themes-f11 (p f11)) (jao-themes-f12 (p f12))) - `((ansi-color-bright-blue (c "steelblue3" "steelblue3")) + `((ansi-color-bold bf) + (ansi-color-bright-blue (c "steelblue3" "steelblue3")) (ansi-color-bright-cyan (c "cyan3" "cyan3")) (ansi-color-bright-green (c "darkseagreen3" "darkseagreen3")) (ansi-color-bright-magenta (c "lightpink4" "lightpink4")) @@ -311,23 +314,9 @@ (ansi-color-green (c "darkseagreen4" "darkseagreen4")) (ansi-color-magenta (c "lightpink3" "lightpink3")) (ansi-color-yellow (c "lightgoldenrod3" "lightgoldenrod3")) - (aw-background-face (p dimm)) - (aw-leading-char-face (~ error) bf :height 3.0) - (awesome-tray-module-awesome-tab-face (p f00)) - (awesome-tray-module-battery-face (p f00)) - (awesome-tray-module-battery-face (p f00)) - (awesome-tray-module-buffer-name-face (p f11)) - (awesome-tray-module-circe-face (p f00)) - (awesome-tray-module-date-face (p f00)) - (awesome-tray-module-date-face (p f01)) - (awesome-tray-module-evil-face (p f00)) - (awesome-tray-module-file-path-face (p f00)) - (awesome-tray-module-git-face (p f10)) - (awesome-tray-module-last-command-face (p f00)) - (awesome-tray-module-location-face (p f00)) - (awesome-tray-module-mode-name-face (p f00)) - (awesome-tray-module-parent-dir-face (p f00)) - (awesome-tray-module-rvm-face (p f00))) + (avy-lead-face (c "red" "grey90") bf :height 1.2) + (avy-lead-face-0 (~ avy-lead-face) bf) + (avy-lead-face-1 (~ avy-lead-face))) `((bbdb-company) (bbdb-field-name bf) (bbdb-field-value (~ default)) @@ -505,6 +494,10 @@ (embark-verbose-indicator-documentation it) (embark-verbose-indicator-title (p f00)) (embark-verbose-indicator-shadowed (p dimm)) + (ement-room-reactions-key (~ ement-room-reactions)) + (ement-room-self-face (p warning) nb) + (ement-room-timestamp-header (~ header-line) :height 1.0 nb) + (ement-room-user-face (~ default)) (emms-browser-album-face (p f00) :height 1.0) (emms-browser-artist-face (p f01) :height 1.0) (emms-browser-composer-face (p f02) :height 1.0) @@ -604,6 +597,7 @@ (font-lock-type-face (p type)) (font-lock-variable-name-face (p variable-name)) (font-lock-warning-face (p warning)) + (forge-pullreq-open (c nil nil)) (forge-topic-label bx) (fringe (p dimm)) (fuel-font-lock-debug-error (p error) nul) @@ -816,7 +810,7 @@ (lui-button-face (p link)) (lui-highlight-face (p warning)) (lui-time-stamp-face (p dimm)) - (lui-track-bar (p dimm) :height 0.2 nul nil ex)) + (lui-track-bar (p dimm) nul nil ex)) `((magit-branch (p f00)) (magit-cherry-equivalent (p warning)) (magit-diff-add (~ diff-added)) @@ -837,6 +831,7 @@ (magit-log-head-label-tags (p warning) nbf) (magit-log-graph (p f11)) (magit-log-tag-label (p keyword)) + (magit-process-ok (c nil nil)) (magit-section-highlight (p hilite) ex) (magit-section-heading (~ outline-1)) (magit-section-secondary-heading (~ outline-2)) @@ -940,7 +935,7 @@ (org-ellipsis (p dimm)) (org-formula (p f02)) (org-headline-done (p dimm)) - (org-hide (c dbg dfg)) + (org-hide (c dbg nil)) (org-latex-and-export-specials (~ default)) (org-level-1 (~ outline-1)) (org-level-2 (~ outline-2)) @@ -963,7 +958,7 @@ (org-table (p f01)) (org-tag (p dimm) nbf) (org-target ul) - (org-time-grid dfg dbg) + (org-time-grid (c nil nil)) (org-todo nbf niv (p error)) (org-upcoming-deadline (p f02)) (org-verbatim (p hilite)) @@ -976,14 +971,14 @@ (outline-6 nbf ul (p outline-6)) (outline-7 nbf ul (p outline-7)) (outline-8 nbf ul (p outline-8)) - (outline-minor-1 bf (~ outline-1) (c nil "grey95") ex) - (outline-minor-2 bf (~ outline-2) (c nil "grey95") ex) - (outline-minor-3 bf (~ outline-3) (c nil "grey95") ex) - (outline-minor-4 bf (~ outline-4) (c nil "grey95") ex) - (outline-minor-5 bf (~ outline-5) (c nil "grey95") ex) - (outline-minor-6 bf (~ outline-6) (c nil "grey95") ex) - (outline-minor-7 bf (~ outline-7) (c nil "grey95") ex) - (outline-minor-8 bf (~ outline-8) (c nil "grey95") ex)) + (outline-minor-1 nbf (~ outline-1) ex) + (outline-minor-2 nbf (~ outline-2) ex) + (outline-minor-3 nbf (~ outline-3) ex) + (outline-minor-4 nbf (~ outline-4) ex) + (outline-minor-5 nbf (~ outline-5) ex) + (outline-minor-6 nbf (~ outline-6) ex) + (outline-minor-7 nbf (~ outline-7) ex) + (outline-minor-8 nbf (~ outline-8) ex)) `((powerline-active1 (~ mode-line)) (powerline-active2 (~ mode-line-inactive)) (powerline-inactive1 (~ mode-line-inactive)) @@ -1016,6 +1011,7 @@ (rst-level-8-face (~ outline-8))) `((secondary-selection (p hilite) ex) (separator-line (~ default) (st "grey85")) + (sh-heredoc (~ font-lock-doc-face)) (sh-quoted-exec (p f00)) (shortdoc-heading (p outline-1) nul) (shortdoc-section (p outline-2)) @@ -1080,18 +1076,30 @@ (success (p success)) (sunshine-forecast-date-face (~ default)) (sunshine-forecast-day-divider-face (p dimm)) - (sunshine-forecast-headline-face (~ header-line))) - `((telega-button (~ button)) + (sunshine-forecast-headline-face (~ header-line)) + (symbol-overlay-face-1 (c nil "brown1")) + (symbol-overlay-face-2 (c nil "lightsalmon1")) + (symbol-overlay-face-3 (c nil "tomato1")) + (symbol-overlay-face-4 (c nil "coral")) + (symbol-overlay-face-5 (~ symbol-overlay-face-1)) + (symbol-overlay-face-6 (~ symbol-overlay-face-2)) + (symbol-overlay-face-7 (~ symbol-overlay-face-3)) + (symbol-overlay-face-8 (~ symbol-overlay-face-4))) + `((tab-bar (~ header-line)) + (telega-button (~ button)) (telega-button-active (~ button)) + (telega-entity-type-spoiler (c dfg dbg)) (telega-msg-heading (p f00)) (telega-msg-self-title (p f01)) (telega-root-heading (p hilite)) (textsec-suspicious (~ default) bx) - (term (~ default)) + (term (c dfg dbg)) (tool-bar (~ default)) (tooltip :family ,jao-themes--face-family (c nil "lightyellow") :height 0.9) (trailing-whitespace (p error)) + (transient-key-exit (p error) bf) + (transient-key-stay (p f00) bf) (treemacs-root-face nul bf :scale 1.1) (twittering-timeline-footer-face (~ header-line)) (twittering-timeline-header-face (~ header-line)) |