diff options
Diffstat (limited to 'lib/eos')
| -rw-r--r-- | lib/eos/jao-afio.el | 388 | ||||
| -rw-r--r-- | lib/eos/jao-borgmatic.el | 9 | ||||
| -rw-r--r-- | lib/eos/jao-buffers.el | 125 | ||||
| -rw-r--r-- | lib/eos/jao-dirmon.el | 42 | ||||
| -rw-r--r-- | lib/eos/jao-ednc.el | 16 | ||||
| -rw-r--r-- | lib/eos/jao-eshell-here.el | 15 | ||||
| -rw-r--r-- | lib/eos/jao-mac.el | 269 | ||||
| -rw-r--r-- | lib/eos/jao-minibuffer.el | 112 | ||||
| -rw-r--r-- | lib/eos/jao-mode-line.el | 70 | ||||
| -rw-r--r-- | lib/eos/jao-notify.el | 37 | ||||
| -rw-r--r-- | lib/eos/jao-shell.el | 95 | ||||
| -rw-r--r-- | lib/eos/jao-sleep.el | 16 | ||||
| -rw-r--r-- | lib/eos/jao-themes.el | 1287 | ||||
| -rw-r--r-- | lib/eos/jao-tracking.el | 121 | ||||
| -rw-r--r-- | lib/eos/jao-weather.el | 39 |
15 files changed, 2338 insertions, 303 deletions
diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el index 306a1d5..b23e6af 100644 --- a/lib/eos/jao-afio.el +++ b/lib/eos/jao-afio.el @@ -1,6 +1,6 @@ ;;; jao-afio.el --- workspaces in just one frame -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022 jao +;; Copyright (C) 2020, 2021, 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: frames @@ -18,249 +18,315 @@ ;; 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 'multisession) (require 'cl-lib) +(require 'jao-doc-session) +(require 'jao-pdf) + +(defvar jao-afio-use-frames (not window-system)) +(defvar jao-afio-frame-parameters nil) +(defvar jao-afio-persist-configurations nil) (defvar jao-open-doc-fun 'find-file) (defvar jao-afio-mail-function 'gnus) (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)) +(defvar jao-afio--config-names + '((?c . "main") (?s . "scratch") (?g . "mail") + (?p . "docs") (?w . "web") (?t . "chats"))) + +(define-multisession-variable jao-afio-configurations nil) -(defun jao-afio--check-frame-p () - (assoc 'afio (frame-parameters))) +(defmacro jao-afio-add-frame-parameters (name &rest params) + `(add-to-list 'jao-afio-frame-parameters + '(,(if name (format "%s" name) 'def) ,params))) -(defun jao-afio--init (&optional f) +(defun jao-afio--current-wc () + (window-state-get (frame-root-window) t)) + +(defun jao-afio-save-configuration () (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 () + (when-let* ((c (jao-afio--current-config))) + (setf (alist-get c (multisession-value jao-afio-configurations)) + (jao-afio--current-wc)) + (message "Configuration of %s saved" (jao-afio-frame-name c)))) + +(defun jao-afio-restore-configuration (c) + (when-let* ((_ jao-afio-persist-configurations) + (c (alist-get c (multisession-value jao-afio-configurations)))) + (window-state-put c) + t)) + +(defun jao-afio--current-config (&optional c f) + (when c (modify-frame-parameters f `((afio . ,c)))) + (frame-parameter f 'afio)) + +(defun jao-afio--set-up-frame (cfg) + (when jao-afio-use-frames + (let ((fn (jao-afio-frame-name cfg))) + (set-frame-name fn) + (when-let* ((params (cadr (or (assoc fn jao-afio-frame-parameters) + (assoc 'def jao-afio-frame-parameters))))) + (modify-frame-parameters nil params))))) + +(defun jao-afio--init (&optional _f) (interactive) - (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 + (jao-afio--set-up-frame ?c) + (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)))))) +(defvar jao-afio-side-buffers '("*eldoc*")) + +;;; 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) + (when-let* ((b (seq-keep #'get-buffer jao-afio-side-buffers))) + (other-window -1) + (switch-to-buffer (car b)) + (other-window 1)))) + ((> fw 162) + (delete-other-windows) + (split-window-horizontally) + (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) - (other-window 1))) - (other-window 1))) + (dolist (doc (or docs (jao-doc-session))) + (when (and (stringp doc) (file-exists-p doc)) + (if (jao-pdf-is-pdf-file doc) (funcall jao-open-doc-fun doc) (find-file doc)) + (other-window 1))) + (other-window 1)) + +(defvar jao-afio-left-width nil) (defun jao-afio-open-doc () (interactive) (delete-other-windows) - (split-window-right) - (let ((docs (cl-remove-if-not (lambda (b) - (with-current-buffer b (jao-doc-view--is-doc))) - (buffer-list)))) + (split-window-right jao-afio-left-width) + (let ((docs (cl-remove-if-not 'jao-doc-session-is-doc (buffer-list)))) (if (car docs) (progn (switch-to-buffer (car docs)) (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-org-agenda () + (interactive) + (org-agenda nil "j") + (when-let* ((w (get-buffer-window "*Org Agenda*"))) + (set-window-margins w 2 1) + (with-current-buffer (window-buffer w) + (setq-local cursor-in-non-selected-windows nil + line-spacing 0.2)))) ;;;###autoload (defun jao-afio-open-www () (interactive) (require 'jao-eww-session) (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-afio-org-agenda) (calendar) (find-file (expand-file-name "inbox.org" org-directory)) + (delete-other-windows) (gnus) - (jao-gnus--set-summary-line)) + ;; (jao-gnus--set-summary-line) + ) (defun jao-afio--mail-sidebar () (other-window 1) (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-afio-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)) +(defvar jao-afio-mail-sidebar-width 60) +(defvar jao-afio-mail-sidebar-right nil) + +(defun jao-afio--open-mail (fun) + (unless (get-buffer "*Calendar*") (calendar)) + (delete-other-windows) + (if (< (frame-width) 160) + (funcall fun) + (let ((w (+ 3 jao-afio-mail-sidebar-width))) + (if jao-afio-mail-sidebar-right + (split-window-horizontally (- w)) + (split-window-horizontally w) + (other-window 1))) + (funcall fun) + ;; (set-window-dedicated-p nil t) + (jao-afio--mail-sidebar))) + ;;;###autoload -(defun jao-afio-open-notmuch () +(defun jao-afio-open-mail () (interactive) - (delete-other-windows) - (split-window-horizontally -80) - (notmuch) - (jao-afio--mail-sidebar)) + (cond ((eq 'gnus jao-afio-mail-function) (jao-afio-open-gnus)) + ((eq 'notmuch jao-afio-mail-function) (jao-afio--open-mail 'notmuch)) + (t (jao-afio-trisect)))) -(defun jao-afio-open-mail-function () +;;;###autoload +(defun jao-afio-toggle-mail-sidebar () (interactive) - (jao-trisect) - (other-window 2) - (delete-window) - (other-window 1) - (funcall jao-afio-mail-function) - (jao-afio--mail-sidebar)) + (setq jao-afio-mail-sidebar-right (not jao-afio-mail-sidebar-right)) + (jao-afio-open-mail)) ;;;###autoload -(defun jao-afio-open-mail () +(defun jao-afio-reset () (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)))) + (let ((c (jao-afio--current-config))) + (unless (jao-afio-restore-configuration c) + (delete-other-windows) + (cl-case c + (?w (jao-afio-open-www)) + (?g (jao-afio-open-mail)) + (?p (jao-afio-open-doc)) + (t (jao-afio-trisect))) + (when jao-afio-persist-configurations (jao-afio-save-configuration))))) + +;;; go to frame +(defsubst jao-afio--find-frame (c) + (seq-find (lambda (f) (eq (jao-afio--current-config nil f) c)) (frame-list))) + +(defun jao-afio-frame-name (&optional c) + (alist-get (or c (jao-afio--current-config)) jao-afio--config-names)) + +(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)))) + (jao-afio--check-frame) + (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))) + (jao-afio--set-up-frame next))) + (window-configuration-to-register (jao-afio--current-config)) + (when (and (not reset) (get-register next)) + (ignore-errors (jump-to-register next))) + (setq reset (or reset (not (get-register next))))) + (jao-afio--current-config next) + (unless (eq current next) (setq jao-afio--previous-config current)) + (when reset (jao-afio-reset))) (run-hooks 'jao-afio-switch-hook)))) -(defun jao-afio--goto-main (&optional reset) +(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) +(defun jao-afio-goto-mail (&optional reset) (interactive "P") - (jao-afio--check-frame) - (jao-afio--goto-frame ?s 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 one-win) (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-borgmatic.el b/lib/eos/jao-borgmatic.el index f5d800d..6be370e 100644 --- a/lib/eos/jao-borgmatic.el +++ b/lib/eos/jao-borgmatic.el @@ -1,6 +1,6 @@ ;;; jao-borgmatic.el --- Simple access to borgmatic -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -116,8 +116,11 @@ (when (and (eq (process-status proc) 'exit) (y-or-n-p "Borg extraction finished, show?")) (if (eq (process-exit-status proc) 0) - (let ((d (file-name-directory (car paths)))) - (dired (expand-file-name d jao-borgmatic-extract-path))) + (let* ((d (file-name-directory (car paths))) + (p (expand-file-name d jao-borgmatic-extract-path))) + (if (file-exists-p p) + (dired p) + (message "%s is not in the archive" d))) (pop-to-buffer jao-borgmatic--extract-output))))) (defvar jao-borgmatic--extract-history nil) diff --git a/lib/eos/jao-buffers.el b/lib/eos/jao-buffers.el new file mode 100644 index 0000000..3339d33 --- /dev/null +++ b/lib/eos/jao-buffers.el @@ -0,0 +1,125 @@ +;;; jao-buffers.el --- deal with buffers and windows -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: files + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + + +;;; deps +(require 'eldoc) + +;;; lines + +;;;###autoload +(defun jao-goto-visible-line (n) + (interactive "NGo to line: ") + (goto-char (point-min)) + (forward-visible-line n)) + +;;; windows +;;;###autoload +(defun transpose-windows (arg) + "Transpose the buffers shown in two windows." + (interactive "p") + (let ((selector (if (>= arg 0) 'next-window 'previous-window))) + (while (/= arg 0) + (let ((this-win (window-buffer)) + (next-win (window-buffer (funcall selector)))) + (set-window-buffer (selected-window) next-win) + (set-window-buffer (funcall selector) this-win) + (select-window (funcall selector))) + (setq arg (if (> arg 0) (1- arg) (1+ arg)))))) +;;; attached buffers +(defun jao-display-buffer-below-selected (buffer alist) + (delete-other-windows-vertically) + (display-buffer-below-selected buffer alist)) + +(defun jao-display-below-eldoc (buffer alist) + (let ((w (selected-window))) + (pop-to-buffer (eldoc-doc-buffer) nil t) + (jao-display-buffer-below-selected buffer alist) + (select-window w t))) + +(defun jao-attached-buffer-entry (name-rx height) + `(,name-rx (display-buffer-reuse-window + jao-display-buffer-below-selected) + (window-height . ,(or height 25)))) + +;;;###autoload +(defmacro jao-with-attached-buffer (name-rx height &rest body) + (declare (indent defun)) + `(let ((display-buffer-alist '(,(jao-attached-buffer-entry name-rx height)))) + ,@body)) + +;;;###autoload +(defun jao-define-attached-buffer (name-rx &optional height) + (add-to-list 'display-buffer-alist + (jao-attached-buffer-entry name-rx height))) + +;;; eldoc +;;;###autoload +(defun jao-eldoc-toggle () + "Toggle eldoc's documentation buffer." + (interactive) + (let ((buffer (eldoc-doc-buffer))) + (if-let* ((w (and buffer (get-buffer-window buffer)))) + (delete-window w) + (eldoc-doc-buffer t)))) + +;;;###autoload +(add-to-list 'display-buffer-alist + '("\\*eldoc\\( .*\\)?\\*" + (display-buffer-reuse-window) + (dedicated . t))) + +(defsubst jao-eldoc-window () (get-buffer-window (eldoc-doc-buffer))) + +;;;###autoload +(defun jao-clear-below-eldoc () + "Delete any windows below the eldoc buffer, if visible" + (interactive) + (unless (jao-eldoc-window) (jao-eldoc-toggle)) + (delete-other-windows-vertically (jao-eldoc-window))) + +;;;###autoload +(defun jao-attach-below-eldoc (rx &optional h) + (add-to-list 'display-buffer-alist + `(,rx + (display-buffer-reuse-window jao-display-below-eldoc) + (height . (or ,h 0.5))))) + +;;; same mode +;;;###autoload +(defun jao-buffer-same-mode (&optional mode pre-fn switch-fn) + (interactive) + (let* ((mode (or mode major-mode)) + (modes (if (symbolp mode) (list mode) mode)) + (pred `(lambda (b) + (let ((b (get-buffer (if (consp b) (car b) b)))) + (member (buffer-local-value 'major-mode b) + ',modes)))) + (buff (read-buffer "Buffer: " nil t pred))) + (when pre-fn (funcall pre-fn)) + (if switch-fn (funcall switch-fn buff) (switch-to-buffer buff)))) + +;;;###autoload +(defun jao-buffer-same-mode-cmd (&optional pop) + (interactive "P") + (jao-buffer-same-mode nil nil (and pop #'pop-to-buffer))) + +(provide 'jao-buffers) +;;; jao-buffers.el ends here diff --git a/lib/eos/jao-dirmon.el b/lib/eos/jao-dirmon.el index 4fb8609..261433d 100644 --- a/lib/eos/jao-dirmon.el +++ b/lib/eos/jao-dirmon.el @@ -1,6 +1,6 @@ ;;; jao-dirmon.el --- little utility to monitor disk usage -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: tools @@ -25,21 +25,47 @@ ;;; Code: (require 'multisession) +(require 'view) (require 'jao-shell) (define-multisession-variable jao-dirmon-last '()) +(defvar jao-dirmon-roots '("/var/local" "~")) + (defun jao-dirmon-dirs () - (jao-shell-cmd-lines "find ~ -mindepth 2 -maxdepth 3 -type d")) + (mapcan (lambda (d) + (jao-shell-cmd-lines + (format "find %s -mindepth 2 -maxdepth 3 -type d" d))) + jao-dirmon-roots)) (defun jao-dirmon-sizes () (mapcar (lambda (f) - (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) +(defvar jao-dirmon-buffer "*jao-dirmon") + +(defun jao-dirmon--show-deltas (old current deltas) + (with-current-buffer (get-buffer-create jao-dirmon-buffer) + (view-mode -1) + (delete-region (point-min) (point-max)) + (insert "High deltas since " (car old) "\n\n") + (dolist (d (seq-sort-by #'cdr #'> deltas)) + (insert (format "- %s: %s Mb\n" (car d) (cdr d)))) + (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))))) + (goto-char (point-min)) + (view-mode 1) + (pop-to-buffer (current-buffer) nil t) + (when (y-or-n-p "Save current state?") + (setf (multisession-value jao-dirmon-last) + (cons (current-time-string) current))))) ;;;###autoload (defun jao-dirmon-report () @@ -49,12 +75,10 @@ (high ())) (dolist (c current) (let ((d (- (cdr c) (alist-get (car c) old 0 nil #'string=)))) - (when (> d jao-dirmon-threshold) - (push c high)))) + (when (> (abs d) jao-dirmon-threshold) + (push (cons (car c) d) 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..8733cb9 100644 --- a/lib/eos/jao-eshell-here.el +++ b/lib/eos/jao-eshell-here.el @@ -1,6 +1,6 @@ ;;; jao-eshell-here.el --- Easy opening of eshell buffers -*- lexical-binding: t; -*- -;; Copyright (C) 2021 jao +;; Copyright (C) 2021, 2023, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: eshell @@ -25,6 +25,11 @@ ;;; Code: (require 'eshell) +(require 'esh-mode) +(require 'em-dirs) +(require 'jao-buffers) +(require 'project) + (defvar jao-eshell-here-display-buffer-alist '(("^\\*eshell" @@ -33,8 +38,8 @@ "Value to use for `display-buffer-alist' when displaying the eshell buffer.") (defun jao-eshell-here--find-window (b) - (when-let (w (seq-find (lambda (w) (eq (window-buffer w) b)) - (window-list))) + (when-let* ((w (seq-find (lambda (w) (eq (window-buffer w) b)) + (window-list)))) (select-window w))) (defun jao-eshell-here--frame-buffer (&optional b) @@ -64,7 +69,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 +80,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-mac.el b/lib/eos/jao-mac.el new file mode 100644 index 0000000..2312c6c --- /dev/null +++ b/lib/eos/jao-mac.el @@ -0,0 +1,269 @@ +;;; jao-mac.el --- Running applescript. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025, 2026 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(require 'thingatpt) +(require 'jao-shell) + +;;; applescript +(defun jao-mac-applescript-prepare (&rest lines) + (let ((script (mapconcat 'identity lines "\r")) + (start)) + (while (string-match "\n" script) + (setq script (replace-match "\r" t t script))) + (while (string-match "'" script start) + (setq start (+ 2 (match-beginning 0)) + script (replace-match "\\'" t t script))) + script)) + +(defun jao-mac-run-applescript (script) + (string-trim (shell-command-to-string (format "osascript -e '%s'" script)))) + +(defun jao-mac-run-applescript* (&rest lines) + (jao-mac-run-applescript (apply #'jao-mac-applescript-prepare lines))) + +(defun jao-mac-tell-app (app &rest script-lines) + (let* ((app-id (string-split app)) + (id (if (> (length app-id) 1) (car app-id) "")) + (app (if (> (length app-id) 1) (cadr app-id) (car app-id))) + (pre (list (format "tell application %s %S" id app))) + (post '("end tell\n"))) + (apply #'jao-mac-run-applescript* (append pre script-lines post)))) + +;;; open + +;;;###autoload +(defun jao-mac-open (thing &rest args) + "Invoke open after formatting thing with args, using `format'" + (jao-shell-exec (format "open %s" (apply #'format thing args)))) + +;;; notifications + +(defun jao-mac-notify (title subtitle msg) + (jao-mac-run-applescript* + (format "display notification %S with title %S subtitle %S" + msg title subtitle))) + +(defun jao-mac-app-badge (app) + "A very hacky, yet efficient, way of getting and apps badge." + (let* ((c (format "lsappinfo info -app %S -only StatusLabel" app)) + (s (shell-command-to-string c))) + (when (string-match ".*=\"\\([0-9]+\\)\" ." s) + (string-to-number (match-string 1 s)))) ) + +;;; Preview + +(declare-function 'doc-view-current-page "doc-view") + +;; https://alvinalexander.com/macos/applescript-how-to-open-pdf-file-in-preview-go-to-page/ +;; This will work as long as Preview is the default app for the file at hand. +;;;###autoload +(defun jao-mac-open-in-preview (&optional file page _height) + (interactive) + (let ((file (if file (expand-file-name file) (buffer-file-name))) + (page (or page (and (derived-mode-p 'doc-view-doc) + (doc-view-current-page))))) + (jao-mac-run-applescript* + (format "tell application id \"com.apple.Preview\" to open (POSIX file %S)\r\r" + (file-truename file)) + "delay 1" + "tell application \"System Events\"" + "keystroke \"g\" using {option down, command down}" + (format "keystroke %s" (or page 1)) + "delay 0.1\rkeystroke return\rend tell"))) + + +;;; Dict + +(defvar jao-mac-dict-history nil) + +(defun jao-mac-dict (&optional word) + (interactive (list (thing-at-point 'word))) + (jao-mac-open "dict://%S" + (read-string (format "Look up (%s): " word) + nil + 'jao-mac-dict-history + (substring-no-properties word) + t))) + +;;; Skim +(defvar jao-skim--current-file-script + (jao-mac-applescript-prepare + "tell application \"Skim\"" + " try" + " set theD to front document" + " set theP to (path of theD)" + " set thePg to (get index of current page of theD)" + " return (theP & \"::\" & thePg)" + " on error" + " return \"\"" + " end try" + "end tell")) + +(defun jao-skim-current-doc () + "Returns a list of path and page number for the current Skim doc." + (when-let* ((p (jao-mac-run-applescript jao-skim--current-file-script)) + (p (and (not (string-blank-p p)) p))) + (let ((ps (split-string p "::"))) + (list (car ps) (string-to-number (cadr ps)))))) + +(defun jao-skim-open-current-doc () + (interactive) + (when-let* ((ps (jao-skim-current-doc))) + (apply 'jao-open-doc ps))) + +(defvar jao-skim--current-page-text + (jao-mac-applescript-prepare + "tell application \"Skim\"" + "return the text of the current page of the front document" + "end tell")) + +(defun jao-skim-page-text () + (jao-mac-run-applescript jao-skim--current-page-text)) + +;;;###autoload +(defun jao-skim-view-page-text () + (interactive) + (when-let* ((ps (jao-skim-current-doc)) + (p (car ps)) + (n (cadr ps)) + (txt (jao-skim-page-text)) + (bn (format "*%s - %s - txt*" p n))) + (with-current-buffer (get-buffer-create bn) + (delete-region (point-min) (point-max)) + (insert txt) + (pop-to-buffer (current-buffer))))) + +(defun jao-pdf-skim-org-link (title) + (when-let* ((fp (jao-skim-current-doc)) + (file (file-name-nondirectory (car fp))) + (page (cadr fp)) + (lnk (format "doc:%s::%s" file page))) + (org-link-make-string lnk title))) + +;;;###autoload +(defun jao-mac-open-in-skim (&optional file page _height) + (interactive) + (let* ((file (if file (expand-file-name file) (buffer-file-name))) + (page (or page (and (derived-mode-p 'doc-view-mode) + (doc-view-current-page))))) + (jao-mac-open "skim://%s%s" file (if page (format "#page=%s" page) "")))) + +;;;###autoload +(defun jao-pdf-insert-skim-org-link () + (interactive) + (if-let* ((title (read-string "Title: ")) + (lnk (jao-pdf-skim-org-link title))) + (insert lnk) + (user-error "Skim is not viewing any docs!"))) + +;;; NetNewsWire + +(defvar jao-nnw--current-article-script + (jao-mac-applescript-prepare + "tell application \"NetNewsWire\"" + "try" + "return (the url of the current article)" + "on error" + "return \"\"" + "end try" + "end tell")) + +(defun jao-nnw-current-article () + "The URL of the current article in NetNewsWire" + (jao-mac-run-applescript jao-nnw--current-article-script)) + +(defun jao-nnw-browse-current-article () + "Browse the URL of the current NNW article." + (interactive) + (if-let* ((url (jao-nnw-current-article))) + (unless (string-empty-p url) + (browse-url url)) + (message "No article selected in NetNewsWire"))) + +(defvar jao-nnw--label-cmd + "lsappinfo info -app NetNewsWire -only StatusLabel") + +(defun jao-nnw-unread-count () + (jao-mac-app-badge "NetNewsWire")) + +(defun jao-mac-open-nnw () + (interactive) + (jao-mac-open "-a NetNewsWire")) + +;;; Safari +(defun jao-safari-current-url () + (jao-mac-tell-app "Safari" "return URL of current tab of window 1")) + +(defun jao-safari-browse-current () + "Browse the URL of the current Safari topmost document." + (interactive) + (browse-url (jao-safari-current-url))) + +;;; Firefox +(defvar jao-ffox--current-url-script + (jao-mac-applescript-prepare + "tell application \"Firefox\"" + " activate" + " delay 0.15" + " tell application \"System Events\"" + " keystroke \"l\" using command down" + " delay 0.20" + " keystroke \"c\" using command down" + " end tell" + " delay 0.5" + "end tell" + "return the clipboard")) + +(defun jao-firefox-current-url () + (let ((res (jao-mac-run-applescript jao-ffox--current-url-script))) + (jao-mac-run-applescript "tell application \"Emacs\" to activate") + res)) + +(defun jao-firefox-open () + (interactive) + (jao-mac-open "-a Firefox")) + +;;; DevonThink + +;; (defun jao-devon-tell (&rest script-lines) +;; (apply #'jao-mac-tell-app "id DNtp" script-lines )) + +;; (defun jao-devon-find-url (file) +;; (jao-devon-tell +;; "repeat with db in databases" +;; (format "set res to lookup records with path %S in db" +;; (file-truename file)) +;; "if res /= {} then return the reference URL of (item 1 of res)" +;; "end repeat" +;; "return \"\"")) + +;; (defun jao-devon-show-search (s) +;; (jao-devon-tell (format "show search %S" s) "activate")) + +;; (defun jao-devon-open (file &optional page height) +;; (let ((url (jao-devon-find-url file))) +;; (if (string-empty-p (or url "")) +;; (let ((jao-pdf-open-in-emacs t)) +;; (jao-find-or-open file page height)) +;; (let ((p (if page (format "?page=%s" (- page 1)) ""))) +;; (jao-mac-open "%s%s" url p))))) + +(provide 'jao-mac) +;;; jao-mac.el ends here diff --git a/lib/eos/jao-minibuffer.el b/lib/eos/jao-minibuffer.el index bdafa74..8f8996e 100644 --- a/lib/eos/jao-minibuffer.el +++ b/lib/eos/jao-minibuffer.el @@ -1,6 +1,6 @@ ;;; jao-minibuffer.el --- using the minibuffer to report status -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022 jao +;; Copyright (C) 2020, 2021, 2022, 2024, 2025, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: extensions @@ -27,67 +27,89 @@ (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) +(defvar jao-minibuffer-info-face 'default) +(defvar jao-minibuffer-info-face-alt 'default) (defconst jao-minibuffer--name " *Minibuf-0*") (defun jao-minibuffer--trim (s w) (if (< (string-width (or s "")) w) (format (format "%%%ds" (if jao-minibuffer-align-right w (- w))) s) - (substring s 0 w))) + (substring s 0 (min w (string-width s))))) (defun jao-minibuffer--width () (cond ((numberp jao-minibuffer-frame-width) jao-minibuffer-frame-width) (jao-minibuffer-maximized-frames-p (frame-width)) (t (min (frame-width) (window-width (minibuffer-window)))))) -(defun jao-minibuffer--format-info (&optional info) - (let* ((info (or info jao-minibuffer-info)) - (info (if jao-minibuffer-align-right info (reverse info)))) - (mapconcat #'string-trim - (seq-remove #'string-blank-p (mapcar 'format-mode-line info)) - " "))) +(defun jao-minibuffer--format-info (&optional info alt-p) + (let* ((face (if alt-p jao-minibuffer-info-face-alt jao-minibuffer-info-face)) + (info (or info jao-minibuffer-info)) + (info (if jao-minibuffer-align-right info (reverse info))) + (info (seq-remove #'string-blank-p (mapcar 'format-mode-line info)))) + (propertize (mapconcat #'string-trim info " ") 'face face))) (defun jao-minibuffer--aligned (w) (let* ((msg (jao-minibuffer--format-info)) (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)) (defun jao-minibuffer--prefix (msgs) - (when-let (p (string-join (butlast msgs) "\n")) + (when-let* ((p (string-join (butlast msgs) "\n"))) (unless (string-blank-p p) (concat p "\n")))) (defun jao-minibuffer--format-msg (msg) - (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n"))) - (prefix (jao-minibuffer--prefix msgs)) - (msg (car (last msgs))) + (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n" t))) + (msgs + (seq-remove (lambda (s) (get-text-property 0 'invisible s)) msgs)) + (prefix (if msgs (jao-minibuffer--prefix msgs) "")) + (msg (or (car (last msgs)) "")) (w (string-width msg))) (if jao-minibuffer-align-right (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 + (and (not jao-minibuffer-msg-info) msg) + (let* ((info (jao-minibuffer--format-info jao-minibuffer-msg-info t)) + (sep (if (string-blank-p (or msg "")) "" " - ")) + (pref (let ((len (+ (string-width info) (string-width sep)))) + (format (format "\n%%%ds" len) ""))) + (msg (if (and msg pref) + (replace-regexp-in-string "\n" pref msg) + msg)) + (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) - (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh) - (setq clear-message-function #'jao-minibuffer-refresh) - (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--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,30 @@ (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)) + +(define-minor-mode jao-minibuffer-mode-line-mode + "Show info in mode line instead of minibuffer" + :global t :lighter "" :group 'jao + (let ((e '(" " (:eval jao-minibuffer-info)))) + (if jao-minibuffer-mode-line-mode + (add-to-list 'global-mode-string e) + (setq global-mode-string (delete e global-mode-string))))) + +(defvar jao-minibuffer--title-format nil) + +(define-minor-mode jao-minibuffer-frame-title-mode + "Show info in frame title instead of minibuffer" + :global t :lighter "" :group 'jao + (when (not jao-minibuffer--title-format) + (setq jao-minibuffer--title-format frame-title-format)) + (if jao-minibuffer-frame-title-mode + (setq frame-title-format '("emacs - " (:eval jao-minibuffer-info))) + (setq frame-title-format jao-minibuffer--title-format))) + (provide 'jao-minibuffer) ;;; jao-minibuffer.el ends here diff --git a/lib/eos/jao-mode-line.el b/lib/eos/jao-mode-line.el index 0fd5a2e..d3388e4 100644 --- a/lib/eos/jao-mode-line.el +++ b/lib/eos/jao-mode-line.el @@ -1,6 +1,6 @@ ;;; jao-mode-line.el --- mode-line info -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -31,7 +31,7 @@ ;;;; mode line toggle (defun jao-mode-line--face-height (face &optional all) (let* ((h (face-attribute face :height (window-frame))) - (nh (if (eq 'unspecified h) 1 'unspecified))) + (nh (if (eq 'unspecified h) 10 'unspecified))) (set-face-attribute face (when (not all) (window-frame)) :height nh))) (defun jao-mode-line--set-inactive-face (x frame) @@ -41,21 +41,28 @@ ;;;###autoload (defun jao-mode-line-toggle (&optional all) (interactive "P") - (jao-mode-line--face-height 'mode-line all)) + (jao-mode-line--face-height 'mode-line-active all)) ;;;###autoload (defun jao-mode-line-toggle-inactive (&optional all) (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) - (jao-mode-line--set-inactive-face 1 frame)) + (jao-mode-line--set-inactive-face 10 frame)) ;;;###autoload (defun jao-mode-line-show-inactive (frame) @@ -78,8 +85,6 @@ 'gnus-article-mode 'gnus-summary-mode) mode-line-buffer-identification) - ((derived-mode-p 'circe-channel-mode) - (format "%s [%d]" (buffer-name) (length (circe-channel-nicks)))) ((not (null eww-data)) (or (plist-get eww-data :title) "No title")) (t "%b")))) @@ -101,7 +106,7 @@ ;;;; mode line in minibuffer -(defvar jao-mode-line--old-format nil) +(defvar jao-mode-line--old-format mode-line-format) (defvar jao-mode-line--face nil) (defvar jao-mode-line--inactive-face nil) (defvar jao-mode-line--props @@ -120,32 +125,52 @@ (if inactive jao-mode-line--inactive-face jao-mode-line--face))) (defun jao-mode-line-adjust-faces () - (let ((bg (frame-parameter nil 'background-color))) + (interactive) + (let ((bg (and (display-graphic-p) + (frame-parameter nil 'background-color))) + (ol (and (display-graphic-p) jao-minibuffer-active-buffer-line-color)) + (ul (and (display-graphic-p) + jao-minibuffer-inactive-buffer-line-color))) (jao-mode-line--extract-face nil) (jao-mode-line--extract-face t) - (set-face-attribute 'mode-line nil :box nil :height 1 + (set-face-attribute 'mode-line-active nil :box nil :height 10 :background bg :foreground bg - :overline jao-minibuffer-active-buffer-line-color - :underline jao-minibuffer-inactive-buffer-line-color - :extend t) - (set-face-attribute 'mode-line-inactive nil :box nil :height 1 + :overline ol :underline ul :extend t) + (set-face-attribute 'mode-line-inactive nil :box nil :height 10 :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 +179,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..c1efb58 100644 --- a/lib/eos/jao-notify.el +++ b/lib/eos/jao-notify.el @@ -1,6 +1,6 @@ -;; jao-notify.el -- Interacting with notification daemon +;; jao-notify.el -- Interacting with notification daemon -*- lexical-binding: t; -*- -;; Copyright (c) 2017, 2019, 2020, 2021 Jose Antonio Ortega Ruiz +;; Copyright (c) 2017, 2019, 2020, 2021, 2024, 2025, 2026 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sun Jan 08, 2017 20:24 @@ -12,26 +12,35 @@ ;;; 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")) +(defvar jao-notify-audio-icon nil) (declare-function notifications-notify "notifications") +(declare-function alert "alert") +(declare-function jao-mac-notify "jao-mac") ;; "/usr/share/icons/Papirus/64x64/mimetypes/audio-x-generic.svg" ;; "/usr/share/icons/Tango/scalable/mimetypes/audio-x-generic.svg" -(defun jao-notify (msg &optional title icon) +(defun jao-notify (msg &optional title icon subtitle) (let ((title (when (and title (not (string-blank-p title))) title))) - (if jao-notify-use-messages-p - (message "%s%s%s" (or title "") (if title ": " "") (or msg "")) - (let* ((args `(:timeout ,jao-notify-timeout)) - (args (append args - (if title `(:title ,title :body ,msg) `(:title ,msg)))) - (args (if (and (stringp icon) (file-exists-p icon)) - (append args `(:app-icon ,(format "%s" icon))) - args))) - (apply 'notifications-notify args))))) + (cond ((eq jao-notify-use-messages t) + (message "%s%s%s" (or title "") (if title ": " "") (or msg ""))) + ((eq jao-notify-use-messages 'notification) + (let* ((args `(:timeout ,jao-notify-timeout)) + (args (append args + (if title + `(:title ,title :body ,msg) + `(:title ,msg)))) + (args (if (and (stringp icon) (file-exists-p icon)) + (append args `(:app-icon ,(format "%s" icon))) + args))) + (apply 'notifications-notify args))) + ((eq jao-notify-use-messages 'alert) + (alert msg :title title :icon icon :never-persist t)) + ((eq jao-notify-use-messages 'mac) + (jao-mac-notify title subtitle msg))))) (provide 'jao-notify) diff --git a/lib/eos/jao-shell.el b/lib/eos/jao-shell.el index ff1c160..8745492 100644 --- a/lib/eos/jao-shell.el +++ b/lib/eos/jao-shell.el @@ -1,6 +1,6 @@ ;;; jao-shell.el --- shell utils -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: shell @@ -18,31 +18,94 @@ ;; 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: +(require 'term) -;; shell helpers +;;; term +;;;###autoload +(defvar jao-use-vterm nil) + +;;;###autoload +(defvar jao-use-eat nil) + +(defvar-local jao-term--cmd nil) + +(defvar-local jao-term--cmd nil) -;;; Code: +(defun jao-term--find (cmd) + (seq-find (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'eat-mode 'term-mode 'vterm-mode) + (string= (or jao-term--cmd "") cmd)))) + (buffer-list))) -(defun jao-shell--quote (x) (shell-quote-argument (format "%s" x))) +(declare-function vterm nil) +(declare-function vterm-mode nil) +(defvar vterm-shell) +(defvar vterm-kill-buffer-on-exit) + +(defun jao-exec-in-vterm (cmd bname &optional no-kill) + (if (string-blank-p (or cmd "")) + (vterm) + (let ((vterm-shell cmd) + (vterm-kill-buffer-on-exit (not no-kill)) + (buff (generate-new-buffer bname))) + (switch-to-buffer buff) + (vterm-mode)))) + +;;;###autoload +(defun jao-exec-in-term (cmd &optional name no-kill) + (interactive "SCommand") + (require 'eat nil t) + (cond ((and jao-use-vterm (fboundp 'jao-exec-in-vterm)) + (jao-exec-in-vterm cmd name no-kill)) + ((and jao-use-eat (fboundp 'eat)) + (let ((eat-term-name "xterm-256color")) + (with-current-buffer (eat cmd t) + (setq-local jao-term--cmd cmd)))) + (t (ansi-term "bash" name) + (unless no-kill + (set-process-sentinel (get-buffer-process (current-buffer)) + (lambda (process event) + (when (string= event "finished\n") + (kill-buffer (process-buffer process)))))) + (setq-local jao-term--cmd cmd) + (term-send-string nil (format "%s%s\n" cmd (if no-kill "" ";exit")))))) ;;;###autoload +(defmacro jao-def-exec-in-term (name cmd &rest prelude) + `(defun ,(intern (format "jao-term-%s" name)) (&optional term) + (interactive "P") + ,@prelude + (let ((jao-use-vterm (if term (not jao-use-vterm) jao-use-vterm))) + (if-let* ((b (jao-term--find ,cmd))) + (pop-to-buffer b) + (jao-exec-in-term ,cmd ,(format "*%s*" name)))))) + +;;; shell + (defun jao-shell-cmd-lines (cmd &rest args) - (let ((cmd (concat cmd " " (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 +115,15 @@ "*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)) + (goto-char (point-min)) + (funcall handler))) + +(defun jao-shell-running-p (pr) (eq 0 (jao-shell-exec* t "pidof" pr))) +(defun jao-shell-kill-p (pr) (eq 0 (jao-shell-exec* t "killall" pr))) (provide 'jao-shell) + ;;; jao-shell.el ends here diff --git a/lib/eos/jao-sleep.el b/lib/eos/jao-sleep.el index 93da0e7..3b46031 100644 --- a/lib/eos/jao-sleep.el +++ b/lib/eos/jao-sleep.el @@ -1,6 +1,6 @@ ;;; jao-sleep.el --- Actions upon sleep/awake -*- lexical-binding: t; -*- -;; Copyright (C) 2020 jao +;; Copyright (C) 2020, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: hardware @@ -25,7 +25,7 @@ (defvar jao-sleep-sleep-functions nil) (defvar jao-sleep-awake-functions nil) -(defvar jao-sleep--dbus-registration-object nil) +(defvar jao-sleep--dbus-sleep-registration-object nil) (defun jao-sleep--dbus-sleep-handler (sleep-start) (condition-case nil @@ -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-themes.el b/lib/eos/jao-themes.el new file mode 100644 index 0000000..ed4d038 --- /dev/null +++ b/lib/eos/jao-themes.el @@ -0,0 +1,1287 @@ +;;; jao-themes.el --- a DSL for color themes -*- 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/>. + +;;; Code: + +(require 'ansi-color) +(require 'cl) + +;;; palette +(defvar jao-themes-default-face nil) +(defvar jao-themes-default-family "Hack") +(defvar jao-themes-default-variable-pitch-size 9) +(defvar jao-themes-default-variable-pitch-family "Hack") +(defvar jao-themes-default-size 9) +(defvar jao-themes--face-family jao-themes-default-face) +(defvar jao-themes--variable-pitch-family nil) +(defvar jao-themes--variable-pitch-height nil) +(defvar jao-themes--fg "black") +(defvar jao-themes--bg "white") +(defvar jao-themes--box "grey75") +(defvar jao-themes--hilite nil) +(defvar jao-themes--italic '(it)) +(defvar jao-themes--button '(ul)) +(defvar jao-themes--strike-through '(:strike-through t)) +(defvar jao-themes--outline '((c "darkslategrey"))) +(defvar jao-themes--outline-1 '((p outline))) +(defvar jao-themes--outline-2 '((p outline-1))) +(defvar jao-themes--outline-3 '((p outline-2))) +(defvar jao-themes--outline-4 '((p outline-3))) +(defvar jao-themes--outline-5 '((p outline-4))) +(defvar jao-themes--outline-6 '((p outline-5))) +(defvar jao-themes--outline-7 '((p outline-6))) +(defvar jao-themes--outline-8 '((p outline-7))) +(defvar jao-themes--link '((c "darkgoldenrod4"))) +(defvar jao-themes--visited-link '((c "darkolivegreen4") nul)) +(defvar jao-themes--gnus-mail '(dfg)) +(defvar jao-themes--gnus-news '(dfg)) +(defvar jao-themes--tab-sel '((c nil "grey90") bx)) +(defvar jao-themes--tab-unsel '((c "grey30" "grey85") nbf bx)) +(defvar jao-themes--comment '((c "grey30"))) +(defvar jao-themes--warning '((c "indianred3") nbf)) +(defvar jao-themes--error '((c "indianred3") bf)) +(defvar jao-themes--constant '((c "darkolivegreen") nbf)) +(defvar jao-themes--function '((c "darkolivegreen") nbf)) +(defvar jao-themes--keyword '((c "darkslategrey") nbf)) +(defvar jao-themes--string '((c "skyblue4"))) +(defvar jao-themes--type '((c "darkslategrey"))) +(defvar jao-themes--variable-name '((c "DodgerBlue4"))) +(defvar jao-themes--dimm '((c "grey30") nbf)) +(defvar jao-themes--f00 '((c "dodgerblue4"))) +(defvar jao-themes--f01 '((c "cadetblue4"))) +(defvar jao-themes--f02 '((c "darkslategrey"))) +(defvar jao-themes--f10 '((c "dodgerblue4"))) +(defvar jao-themes--f11 '((c "cadetblue4"))) +(defvar jao-themes--f12 '((c "darkslategrey"))) + +(defgroup jao-themes-faces nil + "Faces for unified custom themes" + :group 'faces) + +(defface jao-themes-hilite '((t :inherit default)) "") +(defface jao-themes-italic '((t :inherit default)) "") +(defface jao-themes-button '((t :inherit default)) "") +(defface jao-themes-strike-through '((t :inherit default)) "") +(defface jao-themes-outline '((t :inherit default)) "") +(defface jao-themes-outline-1 '((t :inherit default)) "") +(defface jao-themes-outline-2 '((t :inherit default)) "") +(defface jao-themes-outline-3 '((t :inherit default)) "") +(defface jao-themes-outline-4 '((t :inherit default)) "") +(defface jao-themes-outline-5 '((t :inherit default)) "") +(defface jao-themes-outline-6 '((t :inherit default)) "") +(defface jao-themes-outline-7 '((t :inherit default)) "") +(defface jao-themes-outline-8 '((t :inherit default)) "") +(defface jao-themes-link '((t :inherit default)) "") +(defface jao-themes-visited-link '((t :inherit default)) "") +(defface jao-themes-gnus-mail '((t :inherit default)) "") +(defface jao-themes-gnus-news '((t :inherit default)) "") +(defface jao-themes-tab-sel '((t :inherit default)) "") +(defface jao-themes-tab-unsel '((t :inherit default)) "") +(defface jao-themes-comment '((t :inherit default)) "") +(defface jao-themes-warning '((t :inherit default)) "") +(defface jao-themes-error '((t :inherit default)) "") +(defface jao-themes-constant '((t :inherit default)) "") +(defface jao-themes-function '((t :inherit default)) "") +(defface jao-themes-keyword '((t :inherit default)) "") +(defface jao-themes-string '((t :inherit default)) "") +(defface jao-themes-type '((t :inherit default)) "") +(defface jao-themes-variable-name '((t :inherit default)) "") +(defface jao-themes-dimm '((t :inherit default)) "") +(defface jao-themes-f00 '((t :inherit default)) "") +(defface jao-themes-f01 '((t :inherit default)) "") +(defface jao-themes-f02 '((t :inherit default)) "") +(defface jao-themes-f10 '((t :inherit default)) "") +(defface jao-themes-f11 '((t :inherit default)) "") +(defface jao-themes-f12 '((t :inherit default)) "") + +(defsubst jao-themes--palette-face (face) + (intern (format "jao-themes--%s" face))) + +(defun jao-themes--normalize-body (body) + (dolist (p '(:inverse-video :underline :inherit) body) + (unless (member p body) + (setq body (append body (list p nil)))))) + +(defun jao-themes--parse-face-body (f) + (cond ((null f) nil) + ((listp f) + (jao-themes--normalize-body + (apply 'append (mapcar 'jao-themes--parse-face-sym f)))))) + +(defsubst jao--put-face (str face) + (put-text-property 0 (length str) 'face face str) + str) + +(defvar jao-themes--default-cidxs + '("#000000" "#cd0000" "#00cd00" "#cdcd00" + "#0000cd" "#cd00cd" "#00cdcd" "#e5e5e5" + "#4d4d4d" "#ff0000" "#00ff00" "#ffff00" + "#0000ff" "#ff00ff" "#00ffff" "#ffffff" + "#000000" "#00002a" "#000055" "#000080" + "#0000aa" "#0000d4" "#002a00" "#002a2a" + "#002a55" "#002a80" "#002aaa" "#002ad4" + "#005500" "#00552a" "#005555" "#005580" + "#0055aa" "#0055d4" "#008000" "#00802a" + "#008055" "#008080" "#0080aa" "#0080d4" + "#00aa00" "#00aa2a" "#00aa55" "#00aa80" + "#00aaaa" "#00aad4" "#00d400" "#00d42a" + "#00d455" "#00d480" "#00d4aa" "#00d4d4" + "#2a0000" "#2a002a" "#2a0055" "#2a0080" + "#2a00aa" "#2a00d4" "#2a2a00" "#2a2a2a" + "#2a2a55" "#2a2a80" "#2a2aaa" "#2a2ad4" + "#2a5500" "#2a552a" "#2a5555" "#2a5580" + "#2a55aa" "#2a55d4" "#2a8000" "#2a802a" + "#2a8055" "#2a8080" "#2a80aa" "#2a80d4" + "#2aaa00" "#2aaa2a" "#2aaa55" "#2aaa80" + "#2aaaaa" "#2aaad4" "#2ad400" "#2ad42a" + "#2ad455" "#2ad480" "#2ad4aa" "#2ad4d4" + "#550000" "#55002a" "#550055" "#550080" + "#5500aa" "#5500d4" "#552a00" "#552a2a" + "#552a55" "#552a80" "#552aaa" "#552ad4" + "#555500" "#55552a" "#555555" "#555580" + "#5555aa" "#5555d4" "#558000" "#55802a" + "#558055" "#558080" "#5580aa" "#5580d4" + "#55aa00" "#55aa2a" "#55aa55" "#55aa80" + "#55aaaa" "#55aad4" "#55d400" "#55d42a" + "#55d455" "#55d480" "#55d4aa" "#55d4d4" + "#800000" "#80002a" "#800055" "#800080" + "#8000aa" "#8000d4" "#802a00" "#802a2a" + "#802a55" "#802a80" "#802aaa" "#802ad4" + "#805500" "#80552a" "#805555" "#805580" + "#8055aa" "#8055d4" "#808000" "#80802a" + "#808055" "#808080" "#8080aa" "#8080d4" + "#80aa00" "#80aa2a" "#80aa55" "#80aa80" + "#80aaaa" "#80aad4" "#80d400" "#80d42a" + "#80d455" "#80d480" "#80d4aa" "#80d4d4" + "#aa0000" "#aa002a" "#aa0055" "#aa0080" + "#aa00aa" "#aa00d4" "#aa2a00" "#aa2a2a" + "#aa2a55" "#aa2a80" "#aa2aaa" "#aa2ad4" + "#aa5500" "#aa552a" "#aa5555" "#aa5580" + "#aa55aa" "#aa55d4" "#aa8000" "#aa802a" + "#aa8055" "#aa8080" "#aa80aa" "#aa80d4" + "#aaaa00" "#aaaa2a" "#aaaa55" "#aaaa80" + "#aaaaaa" "#aaaad4" "#aad400" "#aad42a" + "#aad455" "#aad480" "#aad4aa" "#aad4d4" + "#d40000" "#d4002a" "#d40055" "#d40080" + "#d400aa" "#d400d4" "#d42a00" "#d42a2a" + "#d42a55" "#d42a80" "#d42aaa" "#d42ad4" + "#d45500" "#d4552a" "#d45555" "#d45580" + "#d455aa" "#d455d4" "#d48000" "#d4802a" + "#d48055" "#d48080" "#d480aa" "#d480d4" + "#d4aa00" "#d4aa2a" "#d4aa55" "#d4aa80" + "#d4aaaa" "#d4aad4" "#d4d400" "#d4d42a" + "#d4d455" "#d4d480" "#d4d4aa" "#d4d4d4" + "#080808" "#121212" "#1c1c1c" "#262626" + "#303030" "#3a3a3a" "#444444" "#4e4e4e" + "#585858" "#626262" "#6c6c6c" "#767676" + "#808080" "#8a8a8a" "#949494" "#9e9e9e" + "#a8a8a8" "#b2b2b2" "#bcbcbc" "#c6c6c6" + "#d0d0d0" "#dadada" "#e4e4e4" "#eeeeee")) + +(defvar jao-themes--cidxs nil) +(defvar jao-themes--x-colors nil) +(defvar jao-themes--bold-weight 'semibold) + +(defvar *jao-themes--color-names* nil) +(defvar *jao--parsed-faces* nil) + +(defun jao-themes--color (clr) + (cond ((stringp clr) clr) + ((numberp clr) (or (nth clr jao-themes--cidxs) + (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) + (cond ((listp s) + (cl-case (car s) + (c `(:foreground ,(jao-themes--color (cadr s)) + :background ,(jao-themes--color (caddr s)))) + (p (let ((var (jao-themes--palette-face (cadr s)))) + (when (boundp var) + (let ((val (symbol-value var))) + (if (listp val) + (jao-themes--parse-face-body val) + val))))) + (bf `(:bold t :weight ,(cadr s))) + (ul `(:underline ,(jao-themes--color (cadr s)))) + (st `(:strike-through ,(jao-themes--color (cadr s)))) + (~ (cdr (assq (cadr s) *jao--parsed-faces*))) + (t (list s)))) + ((atom s) + (cl-case s + (~ '(:inherit)) + (dbg `(:background ,jao-themes--bg)) + (dfg `(:foreground ,jao-themes--fg)) + (link (jao-themes--parse-face-body jao-themes--link)) + (vlink (jao-themes--parse-face-body jao-themes--visited-link)) + (bf `(:bold t :weight ,jao-themes--bold-weight)) + (nbf '(:bold t :weight normal)) + (it '(:italic t :slant italic)) + (nit '(:italic nil :slant normal)) + (iv '(:inverse-video t)) + (niv '(:inverse-video nil)) + (ul '(:underline t)) + (nul '(:underline nil)) + (st '(:strike-through t)) + (ex '(:extend t)) + (nex '(:extend nil)) + (bx `(:box (:line-width -1 :color ,jao-themes--box))) + (t (list s)))))) + +(defun jao-themes--make-faces (fs &optional cidxs) + (let ((*jao--parsed-faces* nil) + (jao-themes--cidxs (or cidxs jao-themes--default-cidxs)) + (result nil)) + (dolist (f (sort (jao-themes--dfs fs) 'jao--cmp-faces) (reverse result)) + (let ((body (jao-themes--parse-face-body (cdr f)))) + (push (cons (car f) body) *jao--parsed-faces*) + (push (list (car f) body) result))))) + +(defun jao-themes-parse-face (f) + `(,(car f) ((t ,(jao-themes--parse-face-body (cdr f)))))) + +(defun jao-themes-parse-faces (fs) + (let ((*jao--parsed-faces* nil)) + (mapcar (lambda (f) + (let ((fp (jao-themes--parse-face-body (cdr f)))) + (push (cons (car f) fp) *jao--parsed-faces*) + `(,(car f) ((t ,fp))))) + fs))) + + +(defun jao--cmp-faces (a b) + (let ((ai (cadr (assq '~ a))) + (bi (cadr (assq '~ b)))) + (cond ((and ai (not bi)) nil) + ((and bi (not ai)) t) + ((eq (car a) bi) t) + ((eq (car b) ai) nil) + (t (string< (symbol-name (car a)) + (symbol-name (car b))))))) + +(defun jao-themes--dfs (fs) + (let ((dfs + (append + `((default (c nil nil)) + (jao-themes-hilite (p hilite)) + (jao-themes-italic (p italic)) + (jao-themes-button (p button)) + (jao-themes-strike-through (p strike-through)) + (jao-themes-outline (p outline)) + (jao-themes-outline-1 (p outline-1)) + (jao-themes-outline-2 (p outline-2)) + (jao-themes-outline-3 (p outline-3)) + (jao-themes-outline-4 (p outline-4)) + (jao-themes-outline-5 (p outline-5)) + (jao-themes-outline-6 (p outline-6)) + (jao-themes-outline-7 (p outline-7)) + (jao-themes-outline-8 (p outline-8)) + (jao-themes-link (p link)) + (jao-themes-visited-link (p visited-link)) + (jao-themes-gnus-mail (p gnus-mail)) + (jao-themes-gnus-news (p gnus-news)) + (jao-themes-tab-sel (p tab-sel)) + (jao-themes-tab-unsel (p tab-unsel)) + (jao-themes-comment (p comment)) + (jao-themes-warning (p warning)) + (jao-themes-error (p error)) + (jao-themes-constant (p constant)) + (jao-themes-function (p function)) + (jao-themes-keyword (p keyword)) + (jao-themes-string (p string)) + (jao-themes-type (p type)) + (jao-themes-variable-name (p variable-name)) + (jao-themes-dimm (p dimm)) + (jao-themes-f00 (p f00)) + (jao-themes-f01 (p f01)) + (jao-themes-f02 (p f02)) + (jao-themes-f10 (p f10)) + (jao-themes-f11 (p f11)) + (jao-themes-f12 (p f12))) + `((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")) + (ansi-color-bright-yellow (c "lightgoldenrod2" "lightgoldenrod2")) + (ansi-color-blue (c "steelblue4" "steelblue4")) + (ansi-color-cyan (c "cyan4" "cyan4")) + (ansi-color-italic it) + (ansi-color-green (c "darkseagreen4" "darkseagreen4")) + (ansi-color-magenta (c "lightpink3" "lightpink3")) + (ansi-color-yellow (c "lightgoldenrod3" "lightgoldenrod3")) + (avy-lead-face (c "red" "grey90") bf :height 1.0) + (avy-lead-face-0 (~ avy-lead-face) bf) + (avy-lead-face-1 (~ avy-lead-face))) + `((bbdb-company) + (bbdb-field-name (p f00)) + (bbdb-field-value (~ default)) + (bbdb-name (p f01)) + (bmk-mgr-bookmark-face (~ default)) + (bmk-mgr-folder-face bf) + (bmk-mgr-sel-bookmark-face link) + (bmk-mgr-sel-folder-face bf) + (bold bf) + (bold-italic bf) + (border (c nil nil)) + (buffer-menu-buffer bf) + (button (p button))) + `((calendar-holiday-marker (p f00)) + (circe-highlight-nick-face (p warning)) + (circe-originator-face (p f00)) + (circe-my-message-face (p f10)) + (circe-server-face (p dimm)) + (clojure-test-failure-face (p warning) ul) + (clojure-test-error-face (p error) ul) + (cursor (p error))) + `((change-log-acknowledgement (p f02)) + (change-log-conditionals (p f02)) + (change-log-date (p f01)) + (change-log-email (p f00)) + (change-log-file (p f10)) + (change-log-function (p function)) + (change-log-list (p f11)) + (change-log-name (p keyword)) + (cider-stacktrace-face (~ highlight) ex) + (cider-test-error-face (p warning) ex) + (cider-test-failure-face (p error)) + (cider-test-success-face (p f01)) + (comint-highlight-input (p f01) nbf) + (comint-highlight-prompt (p f00)) + (clojure-keyword-face (p keyword)) + (company-echo-common (p warning)) + (company-scrollbar-bg (p hilite)) + (company-scrollbar-fg (p warning)) + (company-tooltip (~ highlight)) + (company-tooltip-annotation (~ company-tooltip) it) + (company-tooltip-annotation-selection (~ company-tooltip) it ul) + (company-tooltip-selection (~ company-tooltip) ul) + (company-tooltip-common (~ company-tooltip) bf) + (company-tooltip-common-selection + (~ company-tooltip-selection) bf) + (company-preview (~ highlight)) + (company-preview-common (~ company-preview) bf) + (compilation-column-number (p f00) nul) + (compilation-error nbf (p error) nul) + (compilation-info nbf (p f02) nul) + (compilation-line-number (p f01) nul) + (compilation-mode-line-fail (p error)) + (compilation-mode-line-exit (p f01) nbf) + (compilation-mode-line-run (p warning)) + (compilation-warning nbf (p warning) nul) + (completions-annotations (p f10) nit) + (completions-common-part nbf :width normal) + (completions-first-difference bf dfg dbg) + (completions-group-separator (p dimm) st) + (corfu-background (p hilite)) + (corfu-bar (p hilite)) + (corfu-border (~ corfu-bar)) + (corfu-current (~ corfu-bar) ul) + (corfu-echo (~ default)) + (cursor dfg dbg) + (custom-button (~ button)) + (custom-button-mouse (~ button)) + (custom-button-pressed (~ button)) + (custom-button-pressed-unraised (~ button)) + (custom-button-unraised (~ button)) + (custom-changed (p warning)) + (custom-comment (p string)) + (custom-comment-tag (p keyword)) + (custom-documentation (~ font-lock-doc-face)) + (custom-face-tag nbf) + (custom-group-tag bf (p f00) :height 11) + (custom-group-tag-1 bf :family ,jao-themes--face-family + (p f00) :height 11) + (custom-invalid (p error)) + (custom-link link) + (custom-modified (p f10)) + (custom-rogue (p error)) + (custom-saved ul) + (custom-set (p f11)) + (custom-state (p f12)) + (custom-themed (p f00)) + (custom-variable-button (~ button)) + (custom-variable-tag (p variable-name) nbf) + (custom-visibility (p dimm)) + (cvs-handled (p dimm))) + `((darcsum-change-line-face (p warning)) + (darcsum-filename-face (p f00)) + (darcsum-header-face (p f01)) + (darcsum-marked-face (p f00) bf) + (darcsum-need-action-face (p warning)) + (darcsum-need-action-marked-face bf (p warning)) + (diary (p error) nbf) + (dictionary-button-face (p link)) + (dictionary-reference-face (p f11)) + (dictionary-word-definition-face (~ default)) + (dictionary-word-entry-face (p f10)) + (diff-added (p warning) ex) + (diff-changed (p f02) nul) + (diff-context (p dimm)) + (diff-file-header dfg dbg nbf) + (diff-function (p function)) + (diff-header nbf dfg dbg) + (diff-hl-change (p dimm)) + (diff-hl-insert (p dimm)) + (diff-hl-delete (p warn)) + (diff-hunk-header (~ diff-file-header)) + (diff-index bf dfg dbg) + (diff-indicator-added (~ diff-added)) + (diff-indicator-changed (~ diff-changed)) + (diff-indicator-removed (~ diff-removed)) + (diff-nonexistent bf (p error)) + (diff-refine-added (~ diff-added)) + (diff-refine-change (~ diff-changed)) + (diff-refine-removed (~ diff-removed)) + (diff-removed (p error) ex) + (dired-directory (p f02)) + (dired-flagged bf) + (dired-header (p f01)) + (dired-ignored (p dimm)) + (dired-mark (p f00) bf) + (dired-marked bf (p f00)) + (dired-symlink (p f11)) + (dired-warn-writable (p warning)) + (dired-warning (p warning)) + (diredp-number (p f11))) + `((diredp-compressed-file-suffix (~ diredp-file-suffix)) + (diredp-date-time (p f01)) + (diredp-deletion (p error)) + (diredp-deletion-file-name (~ diredp-deletion)) + (diredp-dir-heading bf dfg dbg) + (diredp-dir-name (p f10)) + (diredp-dir-priv dfg dbg bf) + (diredp-display-msg (p f00)) + (diredp-exec-priv dfg dbg bf) + (diredp-executable-tag (p error)) + (diredp-file-name dfg dbg) + (diredp-file-suffix (~ diredp-file-name)) + (diredp-flag-mark (p f00) bf) + (diredp-flag-mark-line (p hilite)) + (diredp-ignored-file-name (p dimm)) + (diredp-link-priv (~ diredp-symlink)) + (diredp-no-priv (~ diredp-read-priv)) + (diredp-other-priv dfg dbg) + (diredp-rare-priv dfg dfg) + (diredp-read-priv dfg dbg bf) + (diredp-symlink (p warning)) + (diredp-write-priv dfg dbg bf)) + `((ediff-current-diff-A (~ diff-added) ex) + (ediff-current-diff-Ancestor (c nil ,jao-themes--box)) + (ediff-current-diff-B (~ ediff-current-diff-A) ex) + (ediff-current-diff-C (~ ediff-current-diff-A) ex) + (ediff-even-diff-A (~ diff-added) bf ex) + (ediff-even-diff-Ancestor (c nil ,jao-themes--box) ex) + (ediff-even-diff-B (~ ediff-even-diff-A)) + (ediff-even-diff-C (~ ediff-even-diff-A)) + (ediff-fine-diff-A (~ ediff-current-diff-A) nbf ul) + (ediff-fine-diff-Ancestor (c nil ,jao-themes--box) ex) + (ediff-fine-diff-B (~ ediff-fine-diff-A)) + (ediff-fine-diff-C (~ ediff-fine-diff-A)) + (ediff-odd-diff-A (~ ediff-even-diff-A)) + (ediff-odd-diff-Ancestor (~ ediff-odd-diff-A) nbf) + (ediff-odd-diff-B (~ ediff-odd-diff-A)) + (ediff-odd-diff-C (~ ediff-odd-diff-A)) + (elpher-gemini-heading1 (p outline-1)) + (elpher-gemini-heading2 (p outline-2)) + (elpher-gemini-heading3 (p outline-3)) + (elpher-gemini-preformatted (~ font-lock-doc-face)) + (elpher-other-url (p link) it) + (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) + (emms-browser-track-face (p f10) :height 1.0) + (emms-browser-year/genre-face (p f11) :height 1.0) + (emms-metaplaylist-mode-current-face (p f00) bf) + (emms-metaplaylist-mode-face (p f00)) + (emms-playlist-selected-face (p f00) bf) + (emms-playlist-track-face (p f00) nbf) + (emms-stream-name-face (p f00)) + (emms-stream-url-face link) + (enwc-connected (p warning)) + (epa-field-body) + (epa-field-name bf) + (epa-mark bf (p f00)) + (epa-string (p f01)) + (epa-validity-disabled) + (epa-validity-high bf) + (epa-validity-low) + (epa-validity-medium) + (erc-action-face (p f02)) + (erc-button (p link)) + (erc-current-nick-face (p error)) + (erc-direct-msg-face (p warning)) + (erc-error-face (p error)) + (erc-header-line (~ header)) + (erc-input-face (p f01)) + (erc-my-nick-face (p warning)) + (erc-nick-default-face (p f00)) + (erc-nick-msg-face (p warning)) + (erc-notice-face (p dimm)) + (erc-pal-face (p warning)) + (erc-prompt-face (f 01)) + (erc-timestamp-face (p dimm)) + (error (p error)) + (escape-glyph (p dimm)) + (eshell-ls-archive (p f12)) + (eshell-ls-backup (p dimm)) + (eshell-ls-clutter (p dimm)) + (eshell-ls-directory (p f02)) + (eshell-ls-executable (p warning)) + (eshell-ls-missing (p dimm)) + (eshell-ls-product (p f01)) + (eshell-ls-readonly (p f01) bf) + (eshell-ls-special bf (p f10)) + (eshell-ls-symlink bf (p f11)) + (eshell-ls-unreadable (p dimm)) + (eshell-prompt (p f00)) + (eww-form-checkbox (p f01) bx) + (eww-form-file (p f00) bx) + (eww-invalid-certificate (p error)) + (eww-lnum-number (p error)) + (eww-valid-certificate (~ success)) + (eww-form-select bx) + (eww-form-text bx (p f11)) + (eww-form-textarea bx) + (eww-form-submit (~ button))) + `((factor-font-lock-comment (~ font-lock-comment-face)) + (factor-font-lock-constructor (~ font-lock-function-name-face)) + (factor-font-lock-declaration (~ font-lock-type-face)) + (factor-font-lock-getter-word (~ font-lock-function-name-face)) + (factor-font-lock-parsing-word (~ font-lock-keyword-face)) + (factor-font-lock-setter-word (~ font-lock-function-name-face)) + (factor-font-lock-stack-effect (~ font-lock-comment-face)) + (factor-font-lock-string (~ font-lock-string-face)) + (factor-font-lock-symbol (~ font-lock-keyword-face)) + (factor-font-lock-symbol-definition (~ font-lock-builtin-face)) + (factor-font-lock-type-definition (~ font-lock-type-face)) + (factor-font-lock-type-name (~ font-lock-type-face)) + (factor-font-lock-vocabulary-name (~ font-lock-constant-face)) + (factor-font-lock-word (~ font-lock-function-name-face)) + (ffap) + (file-name-shadow (p dimm)) + (fill-column-indicator (p dimm)) + (fixed-pitch :family ,jao-themes--face-family) + (flyspell-duplicate nbf (p warning)) + (flyspell-incorrect nbf (p error)) + (font-latex-sectioning-1-face (~ outline-1)) + (font-latex-sectioning-2-face (~ outline-2)) + (font-latex-sectioning-3-face (~ outline-3)) + (font-latex-sectioning-4-face (~ outline-4)) + (font-latex-sectioning-5-face (~ outline-5)) + (font-latex-slide-title-face (p f11)) + (font-latex-warning-face (p warning)) + (font-lock-builtin-face (p keyword)) + (font-lock-comment-delimiter-face (p comment)) + (font-lock-comment-face (p comment)) + (font-lock-constant-face (p constant)) + (font-lock-doc-face (p comment)) + (font-lock-function-name-face (p function)) + (font-lock-keyword-face (p keyword)) + (font-lock-negation-char-face (~ default)) + (font-lock-preprocessor-face (p constant)) + (font-lock-regexp-grouping-backslash bf) + (font-lock-regexp-grouping-construct bf) + (font-lock-string-face (p string)) + (font-lock-type-face (p type)) + (font-lock-variable-name-face (p variable-name)) + (font-lock-warning-face (p warning)) + (forge-pullreq-merged (p dimm)) + (forge-pullreq-open (c nil nil)) + (forge-pullreq-rejected (~ forge-pullreq-merged) st) + (forge-topic-pending (c nil nil)) + (forge-topic-unread (p f00)) + (forge-topic-label bx) + (fringe (p dimm)) + (fuel-font-lock-debug-error (p error) nul) + (fuel-font-lock-debug-info (p f01) nul) + (fuel-font-lock-stack-region (p hilite)) + (fuel-font-lock-xref-link link nul) + (fuel-font-lock-xref-vocab italic nul) + (fuel-font-lock-markup-link link) + (fuel-font-lock-markup-title (~ outline-1)) + (fuel-font-lock-markup-emphasis (~ italic)) + (fuel-font-lock-markup-heading (~ outline-1)) + (fuel-font-lock-markup-strong (~ bold))) + `((geiser-font-lock-autodoc-current-arg (~ highlight)) + (geiser-font-lock-autodoc-identifier + (~ font-lock-function-name-face)) + (geiser-font-lock-doc-button (~ button)) + (geiser-font-lock-doc-link link) + (geiser-font-lock-repl-input (~ default) bf) + (geiser-font-lock-repl-output (~ default)) + (geiser-font-lock-doc-title bf) + (geiser-font-lock-xref-header bf) + (geiser-font-lock-xref-link link nul) + (git-commit-summary-face (p f10)) + (git-gutter-fr:added (~ fringe) nbf) + (git-gutter-fr:deleted (~ fringe) nbf) + (git-gutter-fr:modified (~ fringe) nbf) + (gnus-button (p link) nul) + (gnus-cite-attribution (~ default)) + (gnus-cite-1 (p f10)) + (gnus-cite-2 (p f11)) + (gnus-cite-3 (p f12)) + (gnus-cite-4 (p dimm)) + (gnus-cite-5 (p dimm)) + (gnus-cite-6 (p dimm)) + (gnus-cite-7 (p dimm)) + (gnus-cite-8 (p dimm)) + (gnus-cite-9 (p dimm)) + (gnus-cite-10 (p dimm)) + (gnus-cite-11 (p dimm)) + (gnus-emphasis-bold bf) + (gnus-emphasis-bold-italic bf) + (gnus-emphasis-highlight-words (p hilite)) + (gnus-emphasis-italic (~ default)) + (gnus-emphasis-strikethru st) + (gnus-emphasis-underline ul) + (gnus-emphasis-underline-bold bf ul) + (gnus-emphasis-underline-bold-italic bf ul) + (gnus-emphasis-underline-italic ul) + (gnus-group-mail-1 (p gnus-mail) bf) + (gnus-group-mail-1-empty (p gnus-mail) nbf) + (gnus-group-mail-2 (~ gnus-group-mail-1)) + (gnus-group-mail-2-empty (~ gnus-group-mail-1-empty)) + (gnus-group-mail-3 (~ gnus-group-mail-1)) + (gnus-group-mail-3-empty (~ gnus-group-mail-1-empty)) + (gnus-group-mail-4 (~ gnus-group-mail-1)) + (gnus-group-mail-4-empty (~ gnus-group-mail-1-empty)) + (gnus-group-mail-5 (p f00) bf) + (gnus-group-mail-5-empty (p f00)) + (gnus-group-mail-6 (p dimm) bf) + (gnus-group-mail-6-empty (p dimm)) + (gnus-group-mail-low bf (p dimm)) + (gnus-group-mail-low-empty (p dimm)) + (gnus-group-news-low bf (p dimm)) + (gnus-group-news-low-empty (p dimm)) + (gnus-group-news-1 (p gnus-news) bf) + (gnus-group-news-1-empty (p gnus-news) nbf) + (gnus-group-news-2 (~ gnus-group-news-1)) + (gnus-group-news-2-empty (~ gnus-group-news-1-empty)) + (gnus-group-news-3 (~ gnus-group-news-1)) + (gnus-group-news-3-empty (~ gnus-group-news-1-empty)) + (gnus-group-news-4 (~ gnus-group-news-1)) + (gnus-group-news-4-empty (~ gnus-group-news-1-empty)) + (gnus-group-news-5 (p f00) bf) + (gnus-group-news-5-empty (p f00)) + (gnus-group-news-6 (p dimm) bf) + (gnus-group-news-6-empty (p dimm)) + (gnus-header (~ default)) + (gnus-header-content (p f02)) + (gnus-header-from (p f01)) + (gnus-header-name nbf (p f02)) + (gnus-header-newsgroups (p dimm)) + (gnus-header-subject (p f00) nbf) + (gnus-mouse-face (~ default)) + (gnus-server-agent nbf) + (gnus-server-closed (p warning)) + (gnus-server-denied bf (p error)) + (gnus-server-offline (p dimm)) + (gnus-server-opened bf) + (gnus-signature nit (p f10)) + (gnus-splash dfg dbg) + (gnus-summary-high-undownloaded bf nit dfg dbg) + (gnus-summary-cancelled (p strike-through)) + (gnus-summary-high-unread bf nit) + (gnus-summary-normal-ancient (p dimm)) + (gnus-summary-normal-read (p dimm)) + (gnus-summary-high-ticked bf nit dfg dbg) + (gnus-summary-low-ancient (p dimm)) + (gnus-summary-low-read (p dimm) st) + (gnus-summary-low-ticked (p dimm)) + (gnus-summary-low-unread (p dimm)) + (gnus-summary-low-undownloaded (p dimm)) + (gnus-summary-normal-ancient (p dimm)) + (gnus-summary-normal-read (p dimm)) + (gnus-summary-normal-ticked (p f10) nbf) + (gnus-summary-normal-undownloaded bf dfg dbg) + (gnus-summary-normal-unread dfg dbg) + (gnus-summary-selected (p hilite)) + (gnus-x-face) + (google-translate-listen-button-face (~ button)) + (google-translate-phonetic-face (~ default)) + (google-translate-suggestion-face (p f00)) + (google-translate-suggestion-label-face (p f01)) + (google-translate-text-face (~ default)) + (google-translate-translation-face bf) + (gui-button-face (~ button)) + (gui-element (~ gui-button-face))) + `((haskell-constructor-face (~ haskell-type-face)) + (haskell-type-face (p f12)) + (header-line (~ mode-line-inactive)) + (help-argument-name (p f10)) + (help-key-binding (p f00)) + (helm-selection (p hilite)) + (helm-separator (p dimm)) + (helm-source-header (~ outline-1)) + (helm-ls-git-added-copied-face dfg dbg) + (helm-ls-git-conflict-face (p error)) + (helm-ls-git-deleted-and-staged-face (p dimm)) + (helm-ls-git-deleted-not-staged-face dfg dbg) + (helm-ls-git-modified-and-staged-face (p f10)) + (helm-ls-git-modified-not-staged-face (p warning)) + (helm-ls-git-renamed-modified-face (p warning)) + (helm-ls-git-untracked-face (p error)) + (highlight (p hilite)) + (hydra-face-blue (p f00)) + (hydra-face-red (p error))) + `((ido-first-match (p warning)) + (ido-first-match-face (p warning)) + (ido-incomplete-regexp (p error)) + (ido-indicator (p error) nbf) + (ido-only-match (p error)) + (ido-subdir (p f01)) + (info-header-node bf dfg) + (info-header-xref dfg) + (info-menu-header bf) + (info-menu-star bf dfg) + (info-node (p f00)) + (info-title-1 (~ outline-1) bf) + (info-title-2 (~ outline-2) bf) + (info-title-3 (~ outline-3) bf) + (info-title-4 (~ outline-4) bf) + (Info-quoted (p f01)) + (info-xref link) + (info-xref-visited vlink) + (inform-color link) + (isearch bf (p hilite)) + (isearch-fail (p error)) + (italic (p italic)) + (ivy-confirm (p f01)) + (ivy-current-match (p hilite) ex) + (ivy-grep-info (p f00)) + (ivy-highlight-face (p hilite)) + (ivy-match-required-face (p warning)) + (ivy-minibuffer-match-highlight (c nil nil) ul) + (ivy-minibuffer-match-face-1 (p f00)) + (ivy-minibuffer-match-face-2 (p f10)) + (ivy-minibuffer-match-face-3 (p f01)) + (ivy-minibuffer-match-face-4 (p f01)) + (ivy-modified-buffer it) + (ivy-subdir (p f02)) + (ivy-virtual (~ default) it)) + `((jabber-activity-face dbg dfg nbf) + (jabber-activity-personal-face (p warning) nbf) + (jabber-chat-error (p error)) + (jabber-chat-prompt-foreign (p f00) nbf) + (jabber-chat-prompt-local (p f01) nbf) + (jabber-chat-prompt-system (p f02) nbf) + (jabber-rare-time-face (p dimm)) + (jabber-roster-user-away (p dimm)) + (jabber-roster-user-dnd (p dimm)) + (jabber-roster-user-chatty (p warning) nbf) + (jabber-roster-user-offline (p dimm)) + (jabber-roster-user-online (p f01) nbf) + (jabber-roster-user-xa (p dimm)) + (jabber-title-large (~ default) bf) + (jabber-title-medium bf) + (jabber-title-roster bf (p warning)) + (jao-emms-font-lock-album (p f01)) + (jao-emms-font-lock-artist (p f02)) + (jao-emms-font-lock-title (p f01)) + (jao-emms-font-lock-track dfg dbg) + (jao-frm-from-face (p f00)) + (jao-frm-mailbox-face bf) + (jao-frm-subject-face (p f01)) + (jao-frm-mailno-face bf) + (jao-gnus-face-tree (p dimm)) + (jde-java-font-lock-constant-face (~ font-lock-constant-face)) + (jde-java-font-lock-doc-tag-face (p f02)) + (jde-java-font-lock-package-face (p f02)) + (jde-java-font-lock-link-face (p link)) + (jde-java-font-lock-number-face (~ font-lock-constant-face)) + (jde-java-font-lock-public-face (~ font-lock-keyword-face)) + (jde-java-font-lock-private-face (~ font-lock-keyword-face)) + (jde-java-font-lock-protected-face (~ font-lock-keyword-face)) + (jde-java-font-lock-modifier-face (~ font-lock-keyword-face))) + `((lazy-highlight (p hilite)) + (line-number (p dimm)) + (line-number-current-line (p hilite)) + (link link nul) + (link-visited vlink nul) + (lui-button-face (p link)) + (lui-highlight-face (p warning)) + (lui-time-stamp-face (p dimm)) + (lui-track-bar (p dimm) nul nil ex)) + `((magit-branch (p f00)) + (magit-cherry-equivalent (p warning)) + (magit-diff-add (~ diff-added)) + (magit-diff-context-highlight (p hilite) ex) + (magit-diff-del (~ diff-removed)) + (magit-diff-file-heading (p keyword)) + (magit-diff-file-header (~ diff-file-header)) + (magit-diff-hunk-header (~ diff-hunk-header)) + (magit-diff-none (p dimm)) + (magit-hash (p f12)) + (magit-item-highlight (~ mm-uu-extract) ex) + (magit-item-mark (p warning)) + (magit-log-head-label (p keyword) bf) + (magit-log-head-label-head (p keyword) nbf ul) + (magit-log-head-label-default (p keyword) nbf) + (magit-log-head-label-local (p keyword) nbf) + (magit-log-head-label-remote (p function) bf) + (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)) + (magit-section-title (~ outline-2)) + (Man-underline ul) + (match (p hilite)) + (markdown-pre-face (~ font-lock-constant-face)) + (markdown-code-face (p keyword)) + (markdown-inline-code-face (p function)) + (markdown-italic-face (~ italic)) + (menu (~ default)) + (message-cited-text-1 (p f10)) + (message-cited-text-2 (p f11)) + (message-cited-text-3 (p f12)) + (message-cited-text-4 (p dimm)) + (message-header-cc (p f00) nbf) + (message-header-name (p f01) nbf) + (message-header-newsgroups (p dimm) nbf) + (message-header-other (p f00) nbf) + (message-header-subject (p f00) bf) + (message-header-to (p f00) nbf) + (message-header-xheader (p f00) nbf) + (message-mml (p dimm) nbf) + (message-separator (p warning) nbf) + (mm-uu-extract (p hilite) ex) + (minibuffer-line (p f00)) + (minibuffer-prompt (p f00)) + (mode-line-buffer-id nbf (c nil nil)) + (mode-line-emphasis (p warning)) + (mode-line-highlight (~ mode-line)) + ;; (modeline-mousable (~ mode-line-active)) + ;; (modeline-mousable-minor-mode (~ modeline-mousable)) + (moinmoin-table-pi (p f02)) + (mouse dfg dbg ul) + (mpdel-playlist-current-song-face (p hilite) ex) + (mpdel-tablist-song-name-face (p f00)) + (mpdel-tablist-track-face (~ default)) + (mpdel-tablist-album-face (p f01)) + (mpdel-tablist-disk-face (~ default)) + (mpdel-tablist-date-face (~ default)) + (mpdel-tablist-artist-face (p f01)) + (muse-bad-link (p warning)) + (muse-header-1 (~ outline-1)) + (muse-header-2 (~ outline-2)) + (muse-header-3 (~ outline-3)) + (muse-header-4 (~ outline-4)) + (muse-header-5 (~ outline-5)) + (muse-link link) + (muse-verbatim (p f02))) + `((next-error (p hilite)) + (nobreak-space dbg dfg ul) + (nrepl-error-face (p error)) + (nrepl-input-face (p f01)) + (nrepl-output-face (p f02)) + (nrepl-prompt-face (p f00)) + (nrepl-result-face (~ default)) + (notmuch-crypto-decryption (~ success)) + (notmuch-crypto-part-header (p f11)) + (notmuch-crypto-signature-bad (p error) ul) + (notmuch-crypto-signature-good (~ success)) + (notmuch-crypto-signature-unknown (p error) ul) + (notmuch-crypto-signature-good-key (~ success)) + (notmuch-hello-logo-background (~ default)) + (notmuch-message-summary-face (p f00)) + (notmuch-search-count (p f00)) + (notmuch-search-date (p f01)) + (notmuch-search-flagged-face (p warn)) + (notmuch-search-matching-authors (p f02)) + (notmuch-search-subject (~ default)) + (notmuch-tag-added bf) + (notmuch-tag-deleted (p dimm) st) + (notmuch-tag-face (p f00) it) + (notmuch-tag-unread (p warn)) + (notmuch-tree-match-author-face (p f00)) + (notmuch-tree-match-tag-face (~ default)) + (notmuch-tree-no-match-face (p dimm)) + (notmuch-tree-no-match-date-face (p dimm)) + (notmuch-tree-no-match-subject-face (p dimm)) + (notmuch-tree-no-match-tag-face (p dimm)) + (notmuch-wash-cited-text (~ gnus-cite-1))) + `((orderless-match-face-0 ul) + (orderless-match-face-1 ul) + (orderless-match-face-2 ul) + (orderless-match-face-3 ul) + (org-agenda-date-today (p hilite) ex) + (org-agenda-date-weekend (p dimm)) + (org-agenda-done (p dimm)) + (org-agenda-restriction-lock (~ default)) + (org-agenda-structure (p f00)) + (org-archived (p dimm)) + (org-block (~ default)) + (org-block-begin-line (p dimm)) + (org-block-end-line (p dimm)) + (org-code (p f11)) + (org-column dfg dbg :height 1.0) + (org-date (p f02) nul) + (org-document-info nul) + (org-document-title bf) + (org-done (p dimm) nbf niv) + (org-drawer (p f02)) + (org-ellipsis (p dimm)) + (org-formula (p f02)) + (org-headline-done (p dimm)) + (org-hide (c dbg nil)) + (org-latex-and-export-specials (~ default)) + (org-level-1 (~ outline-1)) + (org-level-2 (~ outline-2)) + (org-level-3 (~ outline-3)) + (org-level-4 (~ outline-4)) + (org-level-5 (~ outline-5)) + (org-level-6 (~ outline-6)) + (org-level-7 (~ outline-7)) + (org-level-8 (~ outline-8)) + (org-link link) + (org-meta-line (p dimm)) + (org-noter-notes-exist-face it) + (org-property-value (~ default)) + (org-roam-link (~ org-link) it) + (org-scheduled (p f01)) + (org-scheduled-previously (p f00) nbf) + (org-scheduled-today (p f01)) + (org-sexp-date (p f01)) + (org-special-keyword (p keyword)) + (org-table (p f01)) + (org-tag (p dimm) nbf) + (org-target ul) + (org-time-grid (p dimm)) + (org-todo nbf niv (p error)) + (org-upcoming-deadline (p f02)) + (org-verbatim (p hilite)) + (org-warning bf (p warning)) + (outline-1 bf (p outline-1)) + (outline-2 bf (p outline-2)) + (outline-3 bf (p outline-3)) + (outline-4 bf (p outline-4)) + (outline-5 nbf ul (p outline-5)) + (outline-6 nbf ul (p outline-6)) + (outline-7 nbf ul (p outline-7)) + (outline-8 nbf ul (p outline-8)) + (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)) + (powerline-inactive2 (~ mode-line)) + (pulsar-generic (p hilite))) + `((query-replace bf (p hilite))) + `((rcirc-bright-nick (p hilite)) + (rcirc-my-nick (p warning)) + (rcirc-nick-in-message (p warning)) + (rcirc-nick-in-message-full-line (~ rcirc-nick-in-message)) + (rcirc-other-nick (p keyword)) + (rcirc-prompt bf) + (rcirc-server (p dimm)) + (rcirc-timestamp (p dimm)) + (rcirc-track-keyword (p warning)) + (rcirc-track-nick (~ rcirc-my-nick) niv) + (rcirc-url nbf link) + (reb-match-0 (p hilite)) + (reb-match-1 (~ secondary-selection)) + (reb-match-2 (~ secondary-selection) bf) + (reb-match-3 (~ secondary-selection) ul) + (region (p hilite) ex) + (rst-level-1-face (~ outline-1)) + (rst-level-2-face (~ outline-2)) + (rst-level-3-face (~ outline-3)) + (rst-level-4-face (~ outline-4)) + (rst-level-5-face (~ outline-5)) + (rst-level-6-face (~ outline-6)) + (rst-level-7-face (~ outline-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)) + (shortdoc-separator (p dimm) st ex) + (shr-code (p hilite)) + (shr-h1 (p outline-1)) + (shr-h2 (p outline-2)) + (shr-h3 (p outline-3)) + (shr-h4 (p outline-4)) + (shr-h5 (p outline-5)) + (shr-h6 (p outline-6)) + (shr-link (p link)) + (shr-text (~ default)) + (show-paren-match (p hilite)) + (show-paren-mismatch (p error)) + (sieve-control-commands (~ font-lock-builtin-face)) + (sieve-tagged-arguments (~ font-lock-constant-face)) + (sieve-test-commands (~ font-lock-keyword-face)) + (sieve-action-commands (~ font-lock-keyword-face)) + (signel-contact-face (p f11)) + (signel-notice (p dimm)) + (signel-notification (p warning)) + (signel-prompt it) + (signel-timestamp (p dimm)) + (signel-user (p f00)) + (slack-channel-button-face (~ link)) + (slack-message-action-face (~ link)) + (slack-message-mention-face (p f01)) + (slack-message-mention-keyword-face (p f01)) + (slack-message-mention-me-face (p error)) + (slack-message-output-header (p f00) it) + (slack-message-output-text (~ default)) + (slack-new-message-marker-face (p warning)) + (slack-preview-face (p f11)) + (slack-search-result-message-header-face it) + (slack-user-profile-header-face (p f01)) + (slack-user-profile-property-name-face bf) + (sldb-frame-line-face (p f00)) + (sldb-frame-label-face (p f01)) + (sldb-condition-face (p f02)) + (selectrum-group-separator (p dimm) :strike-through "grey80") + (selectrum-group-title (p dimm)) + (slime-repl-prompt-face (p f00)) + (slime-repl-input-face (p f00) bf) + (slime-repl-inputed-output-face (p f02)) + (slime-repl-output-face (p string)) + (sp-show-pair-enclosing (~ default)) + (sp-show-pair-match-face (p hilite)) + (sp-show-pair-mismatch-face (p error)) + (spaceline-highlight-face-default (p f00)) + (spaceline-highlight-face-modified (p f01)) + (spaceline-highlight-face (p f02)) + (spaceline-modified (p f10) iv) + (spaceline-unmodified (p f11) iv) + (spaceline-read-only (p f12) iv) + (speedbar-directory-face (~ diredp-dir-heading)) + (speedbar-file-face (~ diredp-file-name)) + (speedbar-highlight-face (p hilite)) + (speedbar-selected-face ul) + (speedbar-separator-face (p f00)) + (shadow (p dimm)) + (success (p success)) + (sunshine-forecast-date-face (~ default)) + (sunshine-forecast-day-divider-face (p dimm)) + (sunshine-forecast-headline-face (~ header-line)) + (switch-window-label-face (p keyword) :height 2.0) + (symbol-overlay-face-1 (c nil "brown1")) + (symbol-overlay-face-2 (c nil "lightsalmon1")) + (symbol-overlay-face-3 (c nil "tomato1")) + (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 (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)) + (twittering-uri-face (~ link)) + (twittering-username-face (p f01))) + `((underline ul)) + `((variable-pitch :family ,jao-themes--variable-pitch-family) + (variable-pitch-text (~ variable-pitch)) + (vertical-border (c ,jao-themes--box nil) :inherit default) + (vertico-current (p hilite)) + (vertico-group-title (p dimm)) + (vertico-group-separator (p dimm) :strike-through "grey80") + (vertico-truncation (~ shadow)) + (vterm-color-green (c "darkseagreen4")) + (vterm-color-blue (c "steelblue4")) + (vterm-color-cyan (c "cadetblue4")) + (vterm-color-red (c "orangered4")) + (vterm-color-magenta (c "dark orange")) + (vterm-color-yellow (c "darkgoldenrod4"))) + `((w3m-anchor link) + (w3m-arrived-anchor vlink) + (w3m-bold bf dbg dfg) + (w3m-current-anchor nbf ul) + (w3m-form dfg dbg ul) + (w3m-form-button (~ button)) + (w3m-form-button-mouse (~ custom-button-mouse)) + (w3m-form-button-pressed (~ custom-button-pressed)) + (w3m-header-line-location-content + :box (:line-width 3 :color ,jao-themes--bg) dfg dbg) + (w3m-header-line-location-title + :box (:line-width 3 :color ,jao-themes--bg) dfg dbg) + (w3m-header-line-content + :box (:line-width 3 :color ,jao-themes--bg) dfg dbg) + (w3m-header-line-title + :box (:line-width 3 :color ,jao-themes--bg) dfg dbg) + (w3m-history-current-url (c nil nil) ul) + (w3m-image (p f10)) + (w3m-image-anchor (c nil nil)) + (w3m-insert (p f12)) + (w3m-italic (~ italic)) + (w3m-linknum-match (p warning)) + (w3m-linknum-minibuffer-prompt (~ minibuffer-prompt)) + (w3m-session-select (p f10)) + (w3m-session-selected bf nul (p f10)) + (w3m-strike-through st) + (w3m-tab-background nul (c nil nil)) + (w3m-tab-mouse (~ default)) + (w3m-tab-selected (p tab-sel)) + (w3m-tab-selected-background (~ default)) + (w3m-tab-selected-retrieving (p tab-sel) it) + (w3m-tab-unselected (p tab-unsel)) + (w3m-tab-unselected-retrieving (p tab-unsel) it) + (w3m-tab-unselected-unseen (p tab-unsel)) + (w3m-underline ul) + (warning (p warning)) + (wg-brace-face (~ default)) + (wg-command-face (p f00)) + (wg-current-workgroup-face (p f11) bf) + (wg-divider-face (~ default)) + (wg-filename-face (~ default)) + (wg-frame-face (~ default)) + (wg-message-face (p string)) + (wg-mode-line-face (~ default)) + (wg-previous-workgroup-face (p f00)) + (wgrep-delete-face st) + (wgrep-done-face (p f00)) + (wgrep-face (p f10) ul) + (wgrep-file-face (p f01)) + (wgrep-reject-face (p error) ul) + (widget-button (~ button)) + (whitespace-line (p error) ul) + (widget-button-pressed nbf (~ custom-button-pressed)) + (widget-button-face (~ button)) + (widget-button-pressed-face (~ button)) + (widget-documentation (p dimm)) + (widget-field (p hilite) bx) + (widget-inactive (p dimm)) + (Widget-single-line-field (~ widget-field)) + (window-divider (~ vertical-border)) + (window-divider-first-pixel (~ window-divider)) + (window-divider-last-pixel (~ window-divider)) + (woman-bold (p f00) bf) + (woman-italic (p f01) nul nit) + (woman-italic-no-ul (p f01) nul nit))))) + (dolist (df dfs fs) + (when (not (assq (car df) fs)) + (push df fs))))) + +(defun jao-themes--adjust-palette (p s) + (if-let* ((v (alist-get s p))) (cons (cons s (car v)) (assoc-delete-all s p)) p)) + +(defun jao-themes--let-palette (palette) + (let ((palette (seq-reduce #'jao-themes--adjust-palette '(fg bg box) palette))) + (mapcar (lambda (f) `(,(jao-themes--palette-face (car f)) ',(cdr f))) + palette))) + +(defun jao-themes--extract-faces (t-faces x-faces) + (let ((result)) + (dolist (f t-faces (reverse result)) + (let ((xfb (cdr (assq (car f) x-faces)))) + (push `(,(car f) ((((type x pgtk ns)) ,@xfb) + (t ,@(cdr f)))) + result))))) + +(defun jao-themes--set-fbg (kind) + (let* ((kvs (cdr (assoc kind window-system-default-frame-alist))) + (f-alist (assq-delete-all 'background-color kvs)) + (f-alist (assq-delete-all 'foreground-color f-alist))) + (when jao-themes--fg + (push (cons 'foreground-color jao-themes--fg) f-alist) + (when (stringp jao-themes--fg) + (set-frame-parameter nil 'foreground-color jao-themes--fg))) + (when jao-themes--bg + (push (cons 'background-color jao-themes--bg) f-alist) + (when (stringp jao-themes--bg) + (set-frame-parameter nil 'background-color jao-themes--bg))) + (setq window-system-default-frame-alist + (cons + (cons kind f-alist) + (assq-delete-all kind window-system-default-frame-alist))))) + +;;;###autoload +(defmacro jao-define-custom-theme (name &rest args) + (let ((palette (cdr (assoc :palette args))) + (x-faces (cdr (assoc :x-faces args))) + (x-colors (cdr (assoc :x-colors args))) + (family (or (cadr (assoc :face-family args)) + jao-themes-default-family)) + (size (or (cadr (assoc :face-size args)) + jao-themes-default-size)) + (vpitch (or (cadr (assoc :variable-pitch-family args)) + jao-themes-default-variable-pitch-family)) + (vsize (or (cadr (assoc :variable-pitch-size args)) + jao-themes-default-variable-pitch-size)) + (bw (or (cadr (assoc :bold-weight args)) jao-themes--bold-weight))) + `(progn + (custom-make-theme-feature ',name) + (deftheme ,name) + (custom-theme-set-variables ',name + '(jao-themes-default-face + ,(format "%s-%s" family size)) + '(jao-themes--face-family ,family) + '(jao-themes--variable-pitch-family + ,vpitch) + '(jao-themes--variable-pitch-height + ,(* 10 vsize)) + '(jao-themes--bold-weight ,bw)) + (let ((*jao-themes--color-names* ',(cdr (assoc :names args))) + (jao-themes--face-family ,family)) + (let* ,(jao-themes--let-palette palette) + (jao-themes--set-fbg 'x) + (jao-themes--set-fbg 'ns) + (jao-themes--set-fbg 'pgtk) + (let* ((xfaces (jao-themes--make-faces ',x-faces ',x-colors)) + (tx-faces (jao-themes--extract-faces xfaces xfaces))) + (apply 'custom-theme-set-faces (cons ',name tx-faces)))))))) + +(put 'jao-define-custom-theme 'lisp-indent-function 1) + +(when load-file-name + (add-to-list 'custom-theme-load-path (file-name-directory load-file-name))) + + + +(provide 'jao-themes) diff --git a/lib/eos/jao-tracking.el b/lib/eos/jao-tracking.el index 520116d..b8514c8 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, 2026 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -18,33 +18,37 @@ ;; 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 +;;; frame tracking for exwm +(with-eval-after-load 'tracking + (add-hook 'exwm-workspace-switch-hook 'tracking-remove-visible-buffers)) + +;;; shorten +;;;###autoload (defun jao-shorten-modes (&rest modes) (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 +57,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 +78,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,18 +88,28 @@ `((t :foreground ,jao-tracking-bkg :background ,jao-tracking-bkg)) "" :group 'faces) -(defun jao-tracking-set-log (v) - (when (member window-system '(x)) - (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0))) +(defvar jao-tracking--pipe + (let ((name "/tmp/emacs.status")) + (unless (file-exists-p name) + (shell-command (format "mkfifo %s" name))) + name)) -(jao-tracking-set-log "") +(defun jao-tracking-set-log (v) + (when (fboundp 'x-change-window-property) + (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0)) + (if (bound-and-true-p jao-wayland-enabled) + (let ((inhibit-message t)) + (shell-command (format "echo \"%s\" > %s" v jao-tracking--pipe))) + (let* ((action (if (string-blank-p v) "remove" "add")) + (cmd (format "wmctrl -r emacs -b %s,demands_attention" action))) + (shell-command-to-string cmd)))) (defun jao-tracking--buffer-str (s) (if (listp s) `(:propertize ,(plist-get s :propertize) face (jao-tracking-minibuffer - ,@(when-let ((f (plist-get s 'face))) + ,@(when-let* ((f (plist-get s 'face))) (jao-tracking-set-log " * ") (list f)))) `(:propertize "|" face jao-tracking-minibuffer-sep))) @@ -114,10 +128,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-weather.el b/lib/eos/jao-weather.el new file mode 100644 index 0000000..50dc56a --- /dev/null +++ b/lib/eos/jao-weather.el @@ -0,0 +1,39 @@ +;;; jao-weather.el --- weather utils -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 jao + +;; Author: jao <mail@jao.io> + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(require 'jao-afio) +(require 'jao-shell) +(require 'term) + +;;; winttr +;;;###autoload +(defun jao-weather (&optional wide) + (interactive "P") + (if (not wide) + (message "%s" + (jao-shell-string "curl -s" + "https://wttr.in/?format=%l++%m++%C+%c+%t+%w++%p")) + (jao-afio-goto-scratch) + (if-let* ((b (get-buffer "*wttr*"))) + (progn (pop-to-buffer b) + (term-send-string (get-buffer-process nil) "clear;curl wttr.in\n")) + (jao-exec-in-term "curl wttr.in" "*wttr*" t)))) + +(provide 'jao-weather) +;;; jao-weather.el ends here |