diff options
72 files changed, 10084 insertions, 9415 deletions
@@ -8,16 +8,6 @@ /lib/media/espotify-embark.el /lib/media/espotify.el /site -/gnus.el -/init.el /bin/ -/blog.el -/completion.el -/email.el -/eww.el -/exwm.el -/org.el /lib/net/signel.el /lib/net/signel.shell -/w3m.el -/notmuch.el diff --git a/attic/counsel.org b/attic/counsel.org deleted file mode 100644 index f6814ae..0000000 --- a/attic/counsel.org +++ /dev/null @@ -1,337 +0,0 @@ -#+title: Completion configuration using ivy, counsel and friends - -* selectrum - #+begin_src emacs-lisp :load no - (use-package selectrum - :ensure t - :init - (defun jao-selectrum--ord-refine (&rest args) - (let ((completion-styles '(orderless))) - (apply #'selectrum-refine-candidates-using-completions-styles args))) - - (defun jao-selectrum-orderless () - (interactive) - (setq selectrum-refine-candidates-function #'jao-selectrum--ord-refine) - (setq selectrum-highlight-candidates-function #'orderless-highlight-matches) - (setq orderless-skip-highlighting (lambda () selectrum-is-active))) - - - :config - ;; https://github.com/raxod502/selectrum/wiki/Ido,-icomplete(fido)-emulation - (defun selectrum-fido-backward-updir () - "Delete char before or go up directory, like `ido-mode'." - (interactive) - (if (and (eq (char-before) ?/) - (eq (selectrum--get-meta 'category) 'file)) - (save-excursion - (goto-char (1- (point))) - (when (search-backward "/" (point-min) t) - (delete-region (1+ (point)) (point-max)))) - (call-interactively 'backward-delete-char))) - - (defun selectrum-fido-delete-char () - "Delete char or maybe call `dired', like `ido-mode'." - (interactive) - (let ((end (point-max))) - (if (or (< (point) end) (not (eq (selectrum--get-meta 'category) 'file))) - (call-interactively 'delete-char) - (dired (file-name-directory (minibuffer-contents))) - (exit-minibuffer)))) - - (defun selectrum-fido-ret () - "Exit minibuffer or enter directory, like `ido-mode'." - (interactive) - (let* ((dir (and (eq (selectrum--get-meta 'category) 'file) - (file-name-directory (minibuffer-contents)))) - (current (selectrum-get-current-candidate)) - (probe (and dir current - (expand-file-name (directory-file-name current) dir)))) - (if (and probe (file-directory-p probe) (not (string= current "./"))) - (selectrum-insert-current-candidate) - (selectrum-select-current-candidate)))) - - ;; (define-key selectrum-minibuffer-map (kbd "RET") 'selectrum-fido-ret) - (define-key selectrum-minibuffer-map (kbd "DEL") 'selectrum-fido-backward-updir) - (define-key selectrum-minibuffer-map (kbd "C-d") 'selectrum-fido-delete-char) - - :custom ((selectrum-complete-in-buffer t) - ;; (selectrum-display-action '(display-buffer-at-bottom)) - (selectrum-extend-current-candidate-highlight t) - (selectrum-fix-vertical-window-height nil) - (selectrum-max-window-height 20) - (selectrum-show-indices nil) - (selectrum-count-style 'current/matches)) - :bind (("C-R" . selectrum-repeat))) - #+end_src -* ivy - #+begin_src emacs-lisp - (use-package ivy - :ensure t - :demand t - :custom - ((ivy-count-format "(%d/%d) ") - (ivy-do-completion-in-region t) - (ivy-height 20) - (ivy-re-builders-alist '((counsel-ag . ivy--regex) - (counsel-rg . ivy--regex) - (counsel-yank-pop . ivy--regex) - (swiper . ivy--regex) - (swiper-isearch . ivy--regex) - (t . ivy--regex-fuzzy))) - (ivy-use-virtual-buffers t) - (ivy-virtual-abbreviate 'abbreviate) - (ivy-wrap t)) - - :config - ;; used by ivy--regex-fuzzy to order results - (use-package flx :ensure t) - - ;; Try C-o in the minibuffer - (use-package ivy-hydra - :after ivy - :ensure t - :init (setq ivy-read-action-function #'ivy-hydra-read-action)) - - (add-to-list 'ivy-initial-inputs-alist - '(gnus-summary-move-article . "")) - - :bind (("C-R" . ivy-resume) - ("C-x b" . ivy-switch-buffer) - ("C-c v" . ivy-push-view) - ("C-c V" . ivy-pop-view)) - :diminish) - #+end_src -* counsel - #+begin_src emacs-lisp - (use-package counsel - :ensure t - :custom ((counsel-describe-function-function 'helpful-callable) - (counsel-describe-variable-function 'helpful-variable) - (counsel-find-file-at-point t) - (counsel-linux-app-format-function - #'counsel-linux-app-format-function-name-pretty) - (counsel-mode-override-describe-bindings nil) - (counsel-recentf-include-xdg-list t)) - :config - :bind (("C-s" . swiper-isearch) - ("C-S-s" . isearch-forward) - ("M-x" . counsel-M-x) - ("C-x f" . counsel-find-file) - ("C-c k" . counsel-ag) - ("C-c K" . counsel-rg) - ("C-c l" . counsel-locate) - ("C-c b" . counsel-git) - ("C-c i" . counsel-imenu) - ("C-c G" . counsel-search) - ("s-r" . counsel-linux-app)) - :diminish) - #+end_src -* counsel add-ons -*** notmuch - #+begin_src emacs-lisp - (use-package counsel-notmuch - :ensure t - :config (with-eval-after-load "gnus-group" - (define-key gnus-group-mode-map "Gg" 'counsel-notmuch))) - #+end_src -*** recoll - #+begin_src emacs-lisp - (require 'jao-recoll) - (defvar jao-counsel-recoll--history nil) - (defun jao-counsel-recoll--function (str) - (let ((xs (counsel-recoll-function str))) - (cl-remove-if-not (lambda (x) (string-prefix-p "file://" x)) xs))) - - (defun jao-counsel-recoll (&optional initial-input) - (interactive) - (counsel-require-program "recoll") - (ivy-read "recoll: " 'jao-counsel-recoll--function - :initial-input initial-input - :dynamic-collection t - :history 'jao-counsel-recoll--history - :action (lambda (x) - (when (string-match "file://\\(.*\\)\\'" x) - (let ((file-name (match-string 1 x))) - (if (string-match "pdf$" x) - (jao-open-doc file-name) - (find-file file-name))))) - :unwind #'counsel-delete-process - :caller 'jao-counsel-recoll)) - - (defun jao-counsel-recoll--recoll (_s) (jao-recoll ivy-text)) - - (ivy-set-actions 'jao-counsel-recoll - '(("x" jao-counsel-recoll--recoll "List in buffer"))) - - (global-set-key (kbd "C-c R") #'jao-counsel-recoll) - #+end_src -* ivy rich - #+begin_src emacs-lisp - (use-package ivy-rich - :after (ivy counsel) - :ensure t - :custom ((ivy-rich-path-style 'relative) - (ivy-rich-parse-remote-buffer nil) - (ivy-rich-parse-remote-file-path nil)) - :config - (ivy-rich-modify-columns - 'ivy-switch-buffer - '((ivy-rich-candidate (:width 80)) - (ivy-rich-switch-buffer-indicators (:face jao-themes-f00)) - (ivy-rich-switch-buffer-project (:width 15)) - (ivy-rich-switch-buffer-major-mode (:width 15 :face jao-themes-f12))))) - #+end_src -* cmap - #+begin_src emacs-lisp - (jao-load-path "cmap") - (use-package cmap - :demand t - :bind (("C-;" . cmap-cmap) - ("C-'" . cmap-default))) - #+end_src -*** prompter - #+begin_src emacs-lisp - (defun jao-cmap--hide-help () - (when-let ((w (get-buffer-window (help-buffer)))) - (with-selected-window w (kill-buffer-and-window)))) - - (defun jao-cmap--prompter (keymap) - (let ((display-buffer-alist '(("*Help*" - (display-buffer-at-bottom) - (window-parameters (mode-line-format . none)) - (window-height . fit-window-to-buffer))))) - (let ((inhibit-message t)) - (describe-keymap keymap)))) - - (defun jao-cmap--prompter-done () - (save-current-buffer (jao-cmap--hide-help))) - - (setq cmap-prompter #'jao-cmap--prompter) - (setq cmap-prompter-done #'jao-cmap--prompter-done) - #+end_src -*** minibuffer actions - #+begin_src emacs-lisp - (defun jao-cmap--completion-metadata () - (completion-metadata - (buffer-substring-no-properties (field-beginning) (point)) - minibuffer-completion-table - minibuffer-completion-predicate)) - - (defun jao-cmap--completion-category () - (completion-metadata-get (jao-cmap--completion-metadata) 'category)) - - (defmacro cmap-define-keymap (v d &rest b) - `(defvar ,v (cmap-keymap ,@b) ,d)) - - (cmap-define-keymap jao-cmap-buffer-map - "Keymap for buffer actions." - ("k" . kill-buffer) - ("b" . switch-to-buffer) - ("o" . switch-to-buffer-other-window) - ("z" . bury-buffer) - ("q" . kill-buffer-and-window) - ("=" . ediff-buffers)) - - ;; (cmap-define-keymap espotify-item-keymap - ;; "Actions for Spotify search results" - ;; ("a" espotify--play-album) - ;; ("h" espotify--show-info)) - - (defvar jao-cmap--smaps - '((command . cmap-command-map) - ;; (espotify-search-item . espotify-item-keymap) - (function . cmap-function-map) - (variable . cmap-variable-map) - (face . cmap-face-map) - (buffer . jao-cmap-buffer-map) - (consult-buffer . jao-cmap-buffer-map))) - - (defun jao-cmap-target-minibuffer-candidate () - (when (minibuffer-window-active-p (selected-window)) - (let ((cand (ivy-state-current ivy-last)) - (cat (jao-cmap--completion-category))) - (when-let (m (alist-get cat jao-cmap--smaps)) - (cons m cand))))) - - (add-to-list 'cmap-targets #'jao-cmap-target-minibuffer-candidate) - #+end_src -*** url / video actions - #+begin_src emacs-lisp - (defvar jao-cmap-video-url-rx - (format "^https?://\\(?:www\\.\\)?%s/.+" - (regexp-opt '("youtu.be" - "youtube.com" - "blip.tv" - "vimeo.com" - "infoq.com") - t)) - "A regular expression matching URLs that point to video streams") - - (defun jao-cmap--play-video (player url) - (interactive "sURL: ") - (let ((cmd (format "%s %s" player (shell-quote-argument url)))) - (start-process-shell-command player nil cmd))) - - (defun jao-cmap-mpv (&optional url) - "Play video stream with mpv" - (interactive "sURL: ") - (jao-cmap--play-video "mpv" url)) - - (defun jao-cmap-vlc (&optional url) - "Play video stream with vlc" - (interactive "sURL: ") - (jao-cmap--play-video "vlc" url)) - - (defun jao-cmap-target-w3m-url () - (when-let (url (or (thing-at-point-url-at-point) - (w3m-anchor) - w3m-current-url)) - (cons 'cmap-url-map url))) - - (defun jao-cmap-kill (&optional x) - "Save to kill ring" - (interactive "s") - (kill-new x)) - - (defun jao-cmap-url (url) - "Browse URL, externally if we're already in emacs-w3m" - (if (derived-mode-p 'w3m-mode) - (jao-browse-with-external-browser url) - (browse-url url))) - - (define-key cmap-url-map [return] #'jao-cmap-url) - (define-key cmap-url-map "f" #'browse-url-firefox) - (define-key cmap-url-map "w" #'jao-cmap-kill) - - (defun jao-cmap-target-video-url () - (when-let (url (jao-cmap-target-w3m-url)) - (when (string-match-p jao-cmap-video-url-rx (cdr url)) - (cons 'jao-cmap-video-url-map (cdr url))))) - - (cmap-define-keymap jao-cmap-video-url-map - "Actions on URLs pointing to remote video streams." - ("v" . jao-cmap-vlc) - ([return] . jao-cmap-mpv)) - - (add-to-list 'cmap-targets #'jao-cmap-target-w3m-url) - (add-to-list 'cmap-targets #'jao-cmap-target-video-url) - #+end_src -* hooks - #+begin_src emacs-lisp - (with-eval-after-load "exwm" - (add-to-list 'exwm-input-global-keys '([?\s-r] . counsel-linux-app))) - - (with-eval-after-load "espotify" - (require 'ivy-spotify) - (defalias 'jao-spotify-album #'ivy-spotify-album) - (defalias 'jao-spotify-track #'ivy-spotify-track) - (defalias 'jao-spotify-artist #'ivy-spotify-artist) - (defalias 'jao-spotify-playlist #'ivy-spotify-playlist)) - #+end_src -* startup - #+begin_src emacs-lisp - (ivy-mode 1) - (counsel-mode 1) - (ivy-rich-mode 1) - (ivy-rich-project-root-cache-mode 1) - #+end_src diff --git a/attic/elisp/jao-custom-modus.el b/attic/elisp/jao-custom-modus.el new file mode 100644 index 0000000..9b2cd8e --- /dev/null +++ b/attic/elisp/jao-custom-modus.el @@ -0,0 +1,159 @@ +;;; jao-custom-themes.el --- color themes based on modus-themes -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 jao + +;; Author: jao <mail@jao.io> +;; Keywords: faces, faces + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Color themes based on modus + +;;; Code: + +(use-package modus-themes + :ensure t + :demand t) + +;;;; Customization +(setq modus-themes-italic-constructs t + modus-themes-bold-constructs t + modus-themes-mixed-fonts nil + modus-themes-subtle-line-numbers t + modus-themes-intense-mouseovers nil + modus-themes-deuteranopia nil + modus-themes-tabs-accented t + modus-themes-variable-pitch-ui nil + modus-themes-inhibit-reload nil + + modus-themes-fringes nil ; {nil,'subtle,'intense} + + ;; Options for `modus-themes-lang-checkers' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `straight-underline', `text-also', `background', + ;; `intense' OR `faint'. + modus-themes-lang-checkers nil + + ;; Options for `modus-themes-mode-line' are either nil, or a list + ;; that can combine any of `3d' OR `moody', `borderless', + ;; `accented', a natural number for extra padding (or a cons cell + ;; of padding and NATNUM), and a floating point for the height of + ;; the text relative to the base font size (or a cons cell of + ;; height and FLOAT) + modus-themes-mode-line '(accented borderless) + + ;; Options for `modus-themes-markup' are either nil, or a list + ;; that can combine any of `bold', `italic', `background', + ;; `intense'. + modus-themes-markup '(background) + + ;; Options for `modus-themes-syntax' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `faint', `yellow-comments', `green-strings', `alt-syntax' + modus-themes-syntax '(faint alt-syntax) + + ;; Options for `modus-themes-hl-line' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `accented', `underline', `intense' + modus-themes-hl-line nil + + ;; Options for `modus-themes-paren-match' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `bold', `intense', `underline' + modus-themes-paren-match '(bold) + + ;; Options for `modus-themes-links' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `neutral-underline' OR `no-underline', `faint' OR `no-color', + ;; `bold', `italic', `background' + modus-themes-links '(neutral-underline) + + ;; Options for `modus-themes-box-buttons' are either nil (the + ;; default), or a list that can combine any of `flat', + ;; `accented', `faint', `variable-pitch', `underline', + ;; `all-buttons', the symbol of any font weight as listed in + ;; `modus-themes-weights', and a floating point number + ;; (e.g. 0.9) for the height of the button's text. + modus-themes-box-buttons '(flat) + + ;; Options for `modus-themes-prompts' are either nil (the + ;; default), or a list of properties that may include any of those + ;; symbols: `background', `bold', `gray', `intense', `italic' + modus-themes-prompts nil + + ;; The `modus-themes-completions' is an alist that reads three + ;; keys: `matches', `selection', `popup'. Each accepts a nil + ;; value (or empty list) or a list of properties that can include + ;; any of the following (for WEIGHT read further below): + ;; + ;; `matches' - `background', `intense', `underline', `italic', WEIGHT + ;; `selection' - `accented', `intense', `underline', `italic', `text-also', WEIGHT + ;; `popup' - same as `selected' + ;; `t' - applies to any key not explicitly referenced (check docs) + ;; + ;; WEIGHT is a symbol such as `semibold', `light', or anything + ;; covered in `modus-themes-weights'. Bold is used in the absence + ;; of an explicit WEIGHT. + modus-themes-completions + '((matches . (regular)) + (selection . (regular accented)) + (popup . (regular accented))) + + modus-themes-mail-citations '(faint) ; {nil,'intense,'faint,'monochrome} + + ;; Options for `modus-themes-region' are either nil (the default), + ;; or a list of properties that may include any of those symbols: + ;; `no-extend', `bg-only', `accented' + modus-themes-region nil + + ;; Options for `modus-themes-diffs': nil, 'desaturated, 'bg-only + modus-themes-diffs 'desaturated + + modus-themes-org-blocks nil ; {nil,'gray-background,'tinted-background} + + modus-themes-org-agenda ; this is an alist: read the manual or its doc string + '((header-block . (light 1.0)) + (header-date . (underline-today grayscale workaholic 1.0)) + (event . (accented italic varied)) + (scheduled . rainbow) + (habit . simplified)) + + ;; The `modus-themes-headings' is an alist with lots of possible + ;; combinations, include per-heading-level tweaks: read the + ;; manual or its doc string + modus-themes-headings + '((0 . (light)) + (1 . (rainbow light)) + (2 . (rainbow light)) + (3 . (rainbow regular)) + (4 . (rainbow regular)) + (5 . (rainbow)) + (t . (semibold)))) + +;;;; Loading themes +(modus-themes-load-themes) + +(defun jao-colors-scheme-dark-p () + (equal "dark" (getenv "JAO_COLOR_SCHEME"))) + +(if (jao-colors-scheme-dark-p) + (modus-themes-load-vivendi) + (modus-themes-load-operandi)) + +;; (jao-mode-line-adjust-faces) + +(provide 'jao-custom-themes) +;;; jao-custom-themes.el ends here diff --git a/attic/elisp/jao-doc-view-imenu.el b/attic/elisp/jao-doc-view-imenu.el new file mode 100644 index 0000000..8b27c38 --- /dev/null +++ b/attic/elisp/jao-doc-view-imenu.el @@ -0,0 +1,74 @@ +;; jao-doc-view-imenu.el --- old docview/imenu -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 jao + +;; Author: jao <mail@jao.io> +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Old code that made its way into emacs 29. It defines imenu entries for +;; docview. + +;;; Code: + +(defvar jao-pdf--outline-rx + "[^\t]+\\(\t+\\)\"\\(.+\\)\"\t#\\(?:page=\\)?\\([0-9]+\\)") + +(defun jao-pdf-outline (&optional file-name) + "Return an alist describing the given FILE-NAME (or current if nil). +The result is cached as a local buffer variable." + (let* ((outline nil) + (fn (or file-name (buffer-file-name))) + (fn (shell-quote-argument (expand-file-name fn)))) + (with-temp-buffer + (insert (shell-command-to-string (format "mutool show %s outline" fn))) + (goto-char (point-min)) + (while (re-search-forward jao-pdf--outline-rx nil t) + (push `((level . ,(length (match-string 1))) + (title . ,(match-string 2)) + (page . ,(string-to-number (match-string 3)))) + outline))) + (setq jao-pdf--outline (nreverse outline)))) + +(defun jao-pdf-imenu--index (items act) + (let ((level (alist-get 'level (car items))) + (index nil)) + (while (and (car items) (<= level (alist-get 'level (car items)))) + (let-alist (car items) + (let ((title (format "%s%s (%s)" "" .title .page))) + (if (> .level level) + (let ((sub (jao-pdf-imenu--index items act)) + (fst (car index))) + (setq index (cdr index)) + (push (cons (car fst) (cons fst (car sub))) index) + (setq items (cdr sub))) + (push `(,title 0 ,act ,.page) index) + (setq items (cdr items)))))) + (cons (nreverse index) items))) + +(defun jao-pdf-imenu-index (&optional goto-page-fn file-name) + "Create an imenu index using `jao-pdf-outline'." + (let* ((goto (or goto-page-fn 'doc-view-goto-page)) + (act (lambda (_name _pos page) (funcall goto page))) + (items (jao-pdf-outline file-name))) + (car (jao-pdf-imenu--index items act)))) + +(defun jao-pdf-set-up-imenu () + (setq-local imenu-create-index-function #'jao-pdf-imenu-index + imenu-submenus-on-top nil + imenu-sort-function nil) + (imenu-add-to-menubar "Outline")) diff --git a/attic/media/jao-emms-info-track.el b/attic/elisp/jao-emms-info-track.el index cf93625..cf93625 100644 --- a/attic/media/jao-emms-info-track.el +++ b/attic/elisp/jao-emms-info-track.el diff --git a/attic/media/jao-emms-lyrics.el b/attic/elisp/jao-emms-lyrics.el index 0ea52e0..0ea52e0 100644 --- a/attic/media/jao-emms-lyrics.el +++ b/attic/elisp/jao-emms-lyrics.el diff --git a/attic/media/jao-emms-random-album.el b/attic/elisp/jao-emms-random-album.el index 72e056b..72e056b 100644 --- a/attic/media/jao-emms-random-album.el +++ b/attic/elisp/jao-emms-random-album.el diff --git a/attic/media/jao-emms.el b/attic/elisp/jao-emms.el index 53b3513..53b3513 100644 --- a/attic/media/jao-emms.el +++ b/attic/elisp/jao-emms.el diff --git a/lib/net/jao-frm.el b/attic/elisp/jao-frm.el index 2658687..2658687 100644 --- a/lib/net/jao-frm.el +++ b/attic/elisp/jao-frm.el diff --git a/attic/net/jao-maildir.el b/attic/elisp/jao-maildir.el index 18a1725..18a1725 100644 --- a/attic/net/jao-maildir.el +++ b/attic/elisp/jao-maildir.el diff --git a/attic/media/jao-mpdn.el b/attic/elisp/jao-mpdn.el index d707767..2e02d59 100644 --- a/attic/media/jao-mpdn.el +++ b/attic/elisp/jao-mpdn.el @@ -1,6 +1,6 @@ ;;; jao-mpdn.el --- Notifications using elmpd -*- lexical-binding: t; -*- -;; Copyright (C) 2021 jao +;; Copyright (C) 2021, 2022 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -116,7 +116,7 @@ (setq jao-mpdn--current (jao-mpdn--parse-retort txt)) (jao-mpdn--update-minibuffer) (cond (next (funcall next)) - ((and (null jao-mpdn--current) jao-random-album-p) + ((and (null jao-mpdn--current) jao-random-album-active) (jao-random-album-next))))))) (jao-mpdn--send "currentsong" cb))) diff --git a/attic/net/jao-notmuch-move.el b/attic/elisp/jao-notmuch-move.el index eb7ea4c..eb7ea4c 100644 --- a/attic/net/jao-notmuch-move.el +++ b/attic/elisp/jao-notmuch-move.el diff --git a/attic/net/jao-notmuch-tree-fold.el b/attic/elisp/jao-notmuch-tree-fold.el index ef528df..ef528df 100644 --- a/attic/net/jao-notmuch-tree-fold.el +++ b/attic/elisp/jao-notmuch-tree-fold.el diff --git a/lib/doc/jao-recoll.el b/attic/elisp/jao-recoll.el index f43451f..b23106f 100644 --- a/lib/doc/jao-recoll.el +++ b/attic/elisp/jao-recoll.el @@ -1,4 +1,4 @@ -;; jao-recoll.el -- Displaying recoll queries +;;; jao-recoll.el -- Displaying recoll queries -*- lexical-binding: t; -*- ;; Copyright (c) 2017, 2020, 2021, 2022 Jose Antonio Ortega Ruiz @@ -22,11 +22,10 @@ ;;; Comentary: ;; A simple interactive command to perform recoll queries and display -;; its results using org-mode. +;; its results using org markup. ;;; Code: - (require 'org) (define-derived-mode recoll-mode org-mode "Recoll" @@ -34,7 +33,7 @@ (read-only-mode 1)) (defvar jao-recoll--file-regexp - "\\(\\w+/.+\\)\t+\\[\\([^]]+\\)\\]\t+\\[\\([^]]+\\)\\].+") + "\\(\\w+/.+\\)\t+\\[\\([^]]+\\)\\]\t+\\[\\([^\t]+\\)\\].+") (defvar jao-recoll-flags "-A -p 5 -n 100") @@ -56,16 +55,36 @@ "*Recoll*" (format "*Recoll: '%s'*" q)))) +(defun jao-recoll--format-snippets (lnk) + (when (looking-at-p "SNIPPETS") + (let ((kill-whole-line t)) + (kill-line) + (while (and (not (eobp)) (not (looking-at-p "/SNIPPETS"))) + (cond ((looking-at "^\\([1-9][0-9]*\\) : ") + (replace-match (format " - [[%s::\\1][\\1]] : " lnk))) + ((looking-at "^0 : \\(.[^\n]+\\)") + (let ((desc (match-string 1))) + (replace-match " - ") + (insert (org-make-link-string lnk desc)))) + (t (insert " - "))) + (forward-line 1)) + (unless (eobp) (kill-line))))) + +(defun jao-recoll--org-link (uri desc mime) + (cond ((string= mime "application/pdf") + (concat "doc:" (file-name-nondirectory uri))) + ((string= mime "message/rfc822") (concat "message:" (substring uri 7))) + ((string= mime "text/x-orgmode-sub") (concat uri "::*" desc)) + (t uri))) + ;;;###autoload (defun jao-recoll (&optional prefix-query) - "Performs a query using recoll and shows the results in a buffer -using org mode." + "Performs a query using recoll and shows the results using org markup." (interactive) (let* ((query (read-string "Recoll query: " prefix-query)) (cmd (format "recoll %s -t %s" jao-recoll-flags (shell-quote-argument query))) - (inhibit-read-only t) - (lnk nil)) + (inhibit-read-only t)) (with-current-buffer (jao-recoll--buffer query) (recoll-mode) (delete-region (point-min) (point-max)) @@ -80,24 +99,20 @@ using org mode." (forward-line 2)) (open-line 1) (while (search-forward-regexp jao-recoll--file-regexp nil t) - (setq lnk - (cond ((string= (match-string 1) "application/pdf") - (concat "doc:" - (file-name-nondirectory (match-string 2)))) - ((string= (match-string 1) "message/rfc822") - (concat "message:" (substring (match-string 2) 7))) - (t (match-string 2)))) - (replace-match (format "* [[%s][\\3]] (\\1)" lnk)) - (forward-line) - (when (looking-at-p "SNIPPETS") - (let ((kill-whole-line t)) - (kill-line) - (while (and (not (eobp)) (not (looking-at-p "/SNIPPETS"))) - (if (looking-at "^\\([1-9][0-9]*\\) : ") - (replace-match (format " - [[%s::\\1][\\1]] : " lnk)) - (insert " - ")) - (forward-line 1)) - (unless (eobp) (kill-line))))) + (let* ((mime (match-string 1)) + (ref (match-string 2)) + (desc (match-string 3)) + (start (match-beginning 0)) + (end (match-end 0)) + (lnk (jao-recoll--org-link ref desc mime)) + (desc (if (string= mime "text/x-orgmode-sub") + (org-link-display-format + (concat (file-name-nondirectory ref) " :: " desc)) + desc))) + (delete-region start end) + (insert "* " (org-make-link-string lnk desc) " (" mime ")") + (forward-line) + (jao-recoll--format-snippets lnk))) (pop-to-buffer (current-buffer)) (goto-char (point-min)) (org-next-visible-heading 1) @@ -111,6 +126,6 @@ using org mode." (define-key recoll-mode-map [?g] 'jao-recoll-requery) (define-key recoll-mode-map [?w] 'jao-recoll-show-query) - +;;; . (provide 'jao-recoll) ;;; jao-recoll.el ends here diff --git a/attic/elisp/misc.el b/attic/elisp/misc.el new file mode 100644 index 0000000..2f1bcb0 --- /dev/null +++ b/attic/elisp/misc.el @@ -0,0 +1,957 @@ +;; -*- lexical-binding: t; -*- + +;;; programming languages +;;;; Erlang +(use-package erlang + :ensure t + :custom ((inferior-erlang-machine-options '("shell")) + (inferior-erlang-machine "rebar3") + (inferior-erlang-shell-type nil) + (erlang-indent-level 4)) + + ;; :bind (:map erlang-mode-map (("C-c C-z" . jao-vterm-repl-pop-to-repl))) + + :init + ;; (require 'jao-vterm-repl) + ;; (add-to-list 'auto-mode-alist '("^rebar\\.config\\`" . erlang-mode)) + ;; (jao-vterm-repl-register "rebar.config" "rebar3 shell" "^[0-9]+> ") + + :config + ;; (defun jao-erlang-current-module () + ;; (when (save-excursion (goto-char (point-min)) + ;; (re-search-forward "^-module(\\([^)]+\\))" nil t)) + ;; (match-string-no-properties 1))) + + ;; (defun jao-erlang-compile (arg) + ;; (interactive "P") + ;; (save-some-buffers) + ;; (when-let ((mname (jao-erlang-current-module))) + ;; (with-current-buffer (jao-vterm-repl) + ;; (vterm-send-string (format "c(%s).\n" mname)) + ;; (sit-for 0) + ;; (setq compilation-last-buffer (current-buffer)) + ;; (when arg (jao-vterm-repl-pop-to-repl))))) + + ;; (setq erlang-shell-function #'jao-vterm-repl + ;; erlang-shell-display-function #'jao-vterm-repl-pop-to-repl + ;; erlang-compile-function #'jao-erlang-compile) + ) +;;;; Idris +(use-package idris-mode + :ensure t + :custom ((idris-interpreter-path "idris2") + (idris-pretty-printer-width 80) + (idris-repl-history-file "~/.emacs.d/cache/idris-history.eld") + (idris-stay-in-current-window-on-compiler-error t))) +(jao-define-attached-buffer "^\\*idris.*") + +;;;; Racket +(use-package racket-mode + :ensure t + :init (setq racket-show-functions '(racket-show-echo-area) + racket-documentation-search-location 'local) + :config + (jao-define-attached-buffer "\\`\\*Racket REPL") + (jao-define-attached-buffer "\\`\\*Racket Describe" 0.5) + (add-hook 'racket-mode-hook #'paredit-mode) + (require 'racket-xp) + (add-hook 'racket-mode-hook #'racket-xp-mode) + :bind (:map racket-xp-mode-map (("C-c C-S-d" . racket-xp-documentation) + ("C-c C-d" . racket-xp-describe)))) + +;;; smart scan +(use-package smartscan + :ensure t + :commands smartscan-mode + :init (add-hook 'prog-mode-hook #'smartscan-mode) + :diminish) + +;;; easy escape +(use-package easy-escape + :ensure t + :config + (set-face-attribute 'easy-escape-face nil :underline t) + (set-face-attribute 'easy-escape-delimiter-face nil :underline t) + :hook (emacs-lisp-mode . easy-escape-minor-mode) + :diminish (easy-escape-minor-mode . "^")) + +;;; vterm +(use-package vterm + :ensure t + :demand t + :commands (vterm vterm-mode) + :init (setq vterm-kill-buffer-on-exit t + vterm-copy-exclude-prompt t + jao-use-vterm t) + :config + + (defun jao-vterm-send-C-c () (interactive) (vterm-send-key "c" nil nil t)) + + (jao-define-attached-buffer "\\*vterm\\*" 0.5) + + :bind (:map vterm-mode-map ("C-c C-c" . jao-vterm-send-C-c))) + +(defun jao-exec-in-vterm (cmd bname) + (if (string-blank-p (or cmd "")) + (vterm) + (let ((vterm-shell cmd) + (vterm-kill-buffer-on-exit t) + (buff (generate-new-buffer bname))) + (switch-to-buffer buff) + (vterm-mode)))) +;;; ace window +(use-package ace-window + :ensure t + :demand t + :init (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) + aw-char-position 'top-left + aw-ignore-current nil + aw-dispatch-when-more-than 2 + aw-leading-char-style 'path + aw-display-mode-overlay t + aw-scope 'frame) + :config + + (defun jao-ace-consult-buffer-other-window (w) + (interactive) + (aw-switch-to-window w) + (consult-buffer)) + + (setf (alist-get ?b aw-dispatch-alist) + '(jao-ace-consult-buffer-other-window "Consult buffer")) + + (setf (alist-get ?B aw-dispatch-alist) + (alist-get ?u aw-dispatch-alist)) + + + :bind (("M-o" . ace-window) + ("M-O" . ace-swap-window) + ("C-x 4 t" . ace-swap-window))) + +;;; switch window +(use-package switch-window + :ensure t + :custom ((switch-window-minibuffer-shortcut ?z) + (switch-window-background t) + (switch-window-shortcut-style 'qwerty) + (switch-window-shortcut-appearance 'text) + (switch-window-timeout 7) + (switch-window-threshold 2)) + :config + (defun jao-switch-window--then (prompt cmd) + (let ((f `(lambda () + (let ((default-directory ,default-directory)) + (call-interactively ',cmd))))) + (switch-window--then prompt f f))) + + (defun jao-switch-window-then-dired () + (interactive) + (jao-switch-window--then "Find directory" 'dired)) + + (defun jao-switch-window-then-find-file () + (interactive) + (jao-switch-window--then "Find file" 'find-file)) + + (defun jao-switch-window-then-consult-buffer () + (interactive) + (jao-switch-window--then "Switch to buffer" 'consult-buffer)) + + :bind (("s-o" . switch-window) + ("C-x 4 d" . jao-switch-window-then-dired) + ("C-x 4 f" . jao-switch-window-then-find-file) + ("C-x 4 b" . jao-switch-window-then-consult-buffer))) + +;;; git helpers +(use-package dired-git-info + :ensure t + :bind (:map dired-mode-map (")" . dired-git-info-mode))) + +(use-package gist :ensure t) + +;;; json +(use-package json-mode :ensure t) +(use-package json-navigator :ensure t) + +;;; deft +(use-package deft + :ensure t + :after jao-org-notes + :commands deft + :init (setq deft-extensions '("org" "md") + deft-directory jao-org-notes-dir + deft-use-filename-as-title nil + deft-use-filter-string-for-name t + deft-file-naming-rules '((noslash . "-") + (nospace . "-") + (case-fn . downcase)) + deft-org-mode-title-prefix t + deft-recursive t + deft-recursive-ignore-dir-regexp (regexp-opt '("." ".." "attic")) + deft-strip-summary-regexp + (concat "\\([\n\t]" + "\\|^#\\+\\(title\\|created\\|date\\|author\\):.*$" + "\\|^#\\+\\(file\\)?tags: *\\)")) + :config (setq deft-strip-title-regexp + (concat "\\(^#\\+title: *\\)\\|" deft-strip-title-regexp)) + :bind (("<f9>" . deft))) + +;;; detached +(use-package detached + :ensure t + :init + (detached-init) + :config + (transient-define-prefix jao-transient-detached () + ["Detached sessions" + ("v" "view session output" detached-view-session) + ("a" "attach to a session" detached-attach-session) + ("=" "diff a session with another session" detached-diff-session) + ("c" "open the session output in compilation mode" detached-compile-session) + ("r" "rerun a session" detached-rerun-session) + ("i" "insert the session's command at point" detached-insert-session-command) + ("w" "copy the session's shell command" detached-copy-session-command) + ("W" "copy the session's output" detached-copy-session) + ("k" "kill an active session" detached-kill-session)]) + + :bind (;; Replace `async-shell-command' with `detached-shell-command' + ([remap async-shell-command] . detached-shell-command) + ;; Replace `compile' with `detached-compile' + ([remap compile] . detached-compile) + ([remap recompile] . detached-compile-recompile) + ;; Replace built in completion of sessions with `consult' + ([remap detached-open-session] . detached-consult-session) + ("s-d" . jao-transient-detached)) + :custom ((detached-show-output-on-attach t) + (detached-terminal-data-command system-type))) + +(defun jao-detached-exec (command) + (if (fboundp 'detached-create-session) + (detached-create-session command) + (jao-shell-exec command))) + +;;; time display +(setq display-time-world-list + '(("Europe/Paris" "Barcelona") + ("America/Los_Angeles" "Los Angeles") + ("America/New_York" "New York") + ("Europe/London" "London") + ("Asia/Calcutta" "Bangalore") + ("Asia/Tokyo" "Tokyo"))) + +(defun jao-time--pdt-hour () + (jao-time-at-zone "%H" "America/Los_Angeles")) + +(defun jao-time--chicago-hour () + (jao-time-at-zone "%H" "America/Chicago")) + +(defun jao-time-at-zone (format zone) + (set-time-zone-rule zone) + (prog1 (format-time-string format) + (set-time-zone-rule nil))) + +(defun jao-time-echo-la-time () + (interactive) + (message (jao-time-at-zone "LA %H:%M" "America/Los_Angeles"))) + +(defun jao-time-echo-times () + (interactive) + (let ((msg (format "%s (%s)" + (format-time-string "%a, %e %B - %H:%M") + (jao-time-at-zone "%H:%M" "America/Los_Angeles")))) + (jao-notify msg "" (jao-data-file "clock-world-icon.png")))) + +(defun jao-time-to-epoch (&optional s) + "Transform a time string to an epoch integer in milliseconds." + (interactive) + (let ((s (or s (read-string "Time string: " (thing-at-point 'string))))) + (message "%s = %s" + s + (round (* 1000 (time-to-seconds (parse-time-string s))))))) + +(defun jao-epoch-to-time (&optional v) + "Transform an epoch, given in milliseconds, to a time string." + (interactive) + (let ((v (or v (read-number "Milliseconds: " (thing-at-point 'number))))) + (message "%s = %s" v + (format-time-string "%Y-%m-%d %H:%M:%S" + (seconds-to-time (/ v 1000.0)))))) +;;; mu4e +(jao-load-path "mu4e") +(use-package mu4e + :init + (setq mu4e-attachment-dir (expand-file-name "~/var/download/attachments") + mu4e-change-filenames-when-moving nil + mu4e-completing-read-function 'completing-read + mu4e-display-update-status-in-modeline nil + mu4e-get-mail-command "true" ;; "run-mb.sh || [ $? -eq 1 ]" + mu4e-headers-show-threads t + mu4e-headers-sort-direction 'ascending + mu4e-headers-visible-columns 100 + mu4e-headers-visible-lines 12 + mu4e-hide-index-messages t + mu4e-index-cleanup t ;; don't do a full cleanup check + mu4e-index-lazy-check t ;; don't consider up-to-date dirs + mu4e-maildir "~/var/mail" + mu4e-split-view 'horizontal ;; 'vertical + mu4e-update-interval 300 + mu4e-use-fancy-chars nil + mu4e-user-mail-address-list jao-mails + mu4e-view-show-addresses t + mu4e-view-show-images t + mu4e-maildir-shortcuts '((:maildir "/jao/inbox" :key ?j) + (:maildir "/bigml/inbox" :key ?b)) + jao-mu4e-uninteresting-mail-query + (concat + "flag:unread AND NOT flag:trashed" + " AND NOT (maildir:/bigml/inbox OR maildir:/bigml/bugs OR" + " maildir:/bigml/support OR maildir:/jao/inbox)") + jao-mu4e-interesting-mail-query + (concat + "flag:unread AND NOT flag:trashed" + " AND (maildir:/bigml/inbox OR maildir:/bigml/bugs OR" + " maildir:/bigml/support OR maildir:/jao/inbox)") + mu4e-bookmarks + `((:name "Inbox" :query ,jao-mu4e-interesting-mail-query :key ?i) + (:name "Other messages" + :query ,jao-mu4e-uninteresting-mail-query + :key 117) + (:name "Today's messages" :query "date:today..now" + :key 116) + (:name "Last 7 days" :query "date:7d..now" :hide-unread t + :key 119) + (:name "Messages with PDFs" + :query "mime:application/pdf OR mime:x-application/pdf" + :key 112))) + + :config + (defun jao-mu4e--maildir (msg) + (when msg + (let ((md (mu4e-message-field msg :maildir))) + (when (string-match "/\\([^/]+\\)/.*" md) + (match-string 1 md))))) + + (defun jao-mu4e--refile-folder (name) + (lambda (msg) + (let ((md (jao-mu4e--maildir msg))) + (if (string= md name) + (concat "/jao/" name) + (format "/%s/%s" md name))))) + + (setq mu4e-sent-folder (jao-mu4e--refile-folder "sent")) + (setq mu4e-drafts-folder (jao-mu4e--refile-folder "drafts")) + (setq mu4e-trash-folder (jao-mu4e--refile-folder "trash")) + (setq mu4e-refile-folder (jao-mu4e--refile-folder "trove")) + + (setq mu4e-contexts nil) + + (setq mu4e-view-show-images t) + (when (fboundp 'imagemagick-register-types) + (imagemagick-register-types)) + + (define-key mu4e-view-mode-map [remap mu4e-view-verify-msg-popup] + 'epa-mail-verify) + + ;; View html message in browser (type aV) + (add-to-list 'mu4e-view-actions + '("ViewInBrowser" . mu4e-action-view-in-browser) t)) + +;;; twtxt +(use-package twtxt + :ensure t + :init (setq twtxt-file (expand-file-name "~/doc/jao.io/twtxt") + twtxt-following + '(("yarn" "https://twtxt.net/user/news/twtxt.txt")))) +;;; corfu bits +(defun jao-corfu-enable-no-auto () + (setq-local corfu-auto nil) + (corfu-mode 1)) + +(defmacro jao-corfu-no-auto (mode) + (let ((mode-name (intern (format "%s-mode" mode))) + (hook-name (intern (format "%s-mode-hook" mode)))) + `(with-eval-after-load ',mode + (add-to-list 'corfu-excluded-modes ',mode-name) + (add-hook ',hook-name #'jao-corfu-enable-no-auto)))) + +(jao-corfu-no-auto eshell) + +;;; gnus bits + +(jao-transient-major-mode gnus-group + ["Search" + ("zc" "consult search" consult-notmuch) + ("zf" "consult folder search" jao-consult-notmuch-folder) + ("g" "gnus search" gnus-group-read-ephemeral-search-group)]) + +(defun jao-gnus-restart-servers () + (interactive) + (message "Restarting all servers...") + (gnus-group-enter-server-mode) + (gnus-server-close-all-servers) + (gnus-server-open-all-servers) + (gnus-server-exit) + (message "Restarting all servers... done")) + +;;;; startup and kill +;; close gnus when closing emacs, but ask when exiting +(setq gnus-interactive-exit t) + +(defun jao-gnus-started-hook () + (add-hook 'before-kill-emacs-hook 'gnus-group-exit)) + +(add-hook 'gnus-started-hook 'jao-gnus-started-hook) + +(defun jao-gnus-after-exiting-hook () + (remove-hook 'before-kill-emacs-hook 'gnus-group-exit)) + +(add-hook 'gnus-after-exiting-gnus-hook 'jao-gnus-after-exiting-hook) + +;; define a wrapper around the save-buffers-kill-emacs +;; to run the new hook before: +(advice-add 'save-buffers-kill-emacs :before (lambda () + (run-hooks 'before-kill-emacs-hook))) + +(defadvice save-buffers-kill-emacs + (before my-save-buffers-kill-emacs activate) + "Install hook when emacs exits before emacs asks to save this and that." + (run-hooks 'before-kill-emacs-hook)) + +(advice-remove 'ad-Advice-save-buffers-kill-emacs 'save-buffers-kill-emacs) + +;;;; delayed expiry +(defvar jao-gnus--expire-every 50) +(defvar jao-gnus--get-count (1+ jao-gnus--expire-every)) + +(defun jao-gnus-get-new-news (&optional arg) + (interactive "p") + (when (and jao-gnus--expire-every + (> jao-gnus--get-count jao-gnus--expire-every)) + (when jao-gnus-use-pm-imap (gnus-group-catchup "nnimap:pm/spam" t)) + (gnus-group-expire-all-groups) + (setq jao-gnus--get-count 0)) + (setq jao-gnus--get-count (1+ jao-gnus--get-count)) + (gnus-group-get-new-news (max (if (= 1 jao-gnus--get-count) 4 3) + (or arg 0)))) + +(define-key gnus-group-mode-map "g" 'jao-gnus-get-new-news) +(define-key gnus-group-mode-map "\C-x\C-s" #'gnus-group-save-newsrc) + +(defun jao-gnus--first-group () + (when (derived-mode-p 'gnus-group-mode) + (gnus-group-first-unread-group))) + +(with-eval-after-load "jao-afio" + (add-hook 'jao-afio-switch-hook #'jao-gnus--first-group)) + +;;;; remove HTML from From contents (arxiv with r2e) +(require 'shr) +(defvar jao-gnus--from-rx + (concat "From: \\\"?\\( " jao-gnus--news-rx "\\)")) + +(defun jao-gnus-remove-anchors () + (save-excursion + (goto-char (point-min)) + (cond ((re-search-forward jao-gnus--from-rx nil t) + (replace-match "" nil nil nil 1)) + ((re-search-forward "[gq].+ updates on arXiv.org: " nil t) + (replace-match "") + (let ((begin (point))) + (when (re-search-forward "^\\(To\\|Subject\\):" nil t) + (beginning-of-line) + (let ((shr-width 10000)) + (shr-render-region begin (1- (point)))))))))) + +(add-hook 'gnus-part-display-hook 'jao-gnus-remove-anchors) + +;;;; find message id +(defun jao-gnus-file-message-id (filename) + (with-temp-buffer + (insert-file filename) + (goto-char (point-min)) + (when (re-search-forward "^[Mm]essage-[Ii][Dd]: <?\\([^><]+\\)>?" nil t) + (match-string 1)))) +;;; old volume controls +(defun jao-player-volume-delta (raise) + (jao-player-vol-delta (if raise 5 -5)) + (sit-for 0.05) + (jao-player-show-volume)) + +(defun jao-player-volume-raise () + (interactive) + (jao-player-volume-delta t)) + +(defun jao-player-volume-lower () + (interactive) + (jao-player-volume-delta nil)) + +(defun jao-player-show-volume () + (interactive) + (jao-notify "Volume" (format "%s%%" (jao-player-volume)))) + +;;; corfu +(use-package corfu + :ensure t + :init (setq corfu-echo-documentation 0.25 + corfu-cycle t + corfu-count 15 + corfu-quit-no-match t + corfu-auto t + corfu-commit-predicate nil + corfu-preview-current nil + corfu-preselect-first t + corfu-min-width 20 + corfu-max-width 100) + :config + + ;; show eldoc string immediately after accepted completion too + (with-eval-after-load "eldoc" + (eldoc-add-command-completions "corfu-")) + + (defun jao-corfu-no-auto () (setq-local corfu-auto nil) (corfu-mode)) + + (add-hook 'eshell-mode-hook #'jao-corfu-no-auto) + + (defun jao-corfu--active-p () + (and (>= corfu--index 0) (/= corfu--index corfu--preselect))) + + (defun jao-corfu-quit-or-insert () + (interactive) + (if (jao-corfu--active-p) (corfu-insert) (corfu-quit))) + + (defun jao-corfu-quit-or-previous () + (interactive) + (if (jao-corfu--active-p) + (corfu-previous) + (corfu-quit) + (previous-line))) + + :bind (:map corfu-map + ("C-<return>" . corfu-insert) + ("\r" . jao-corfu-quit-or-insert) + ("C-p" . jao-corfu-quit-or-previous))) + +(defun corfu-in-minibuffer () + (when (not (bound-and-true-p vertico--input)) + (setq-local corfu-echo-documentation nil) + (corfu-mode 1))) + +(defun jao-corfu-maybe-enable () + (when (and (not jao-wayland-enabled) (display-graphic-p)) + (add-hook 'minibuffer-setup-hook #'corfu-in-minibuffer 1) + (global-corfu-mode 1))) + +(add-hook 'after-init-hook #'jao-corfu-maybe-enable) + +;;; company +(use-package company + :ensure t + :custom ((company-backends '(company-capf + company-bbdb + company-files + company-dabbrev + company-keywords)) + (company-global-modes '(not slack-message-buffer-mode + circe-channel-mode + telega-chat-mode)) + (company-format-margin-function nil) ;; #'company-text-icons-margin + (company-idle-delay 0.2) + (company-lighter "") + (company-lighter-base "") + (company-show-numbers nil) + (company-selection-wrap-around t) + (company-tooltip-limit 15) + (company-tooltip-align-annotations t) + (company-tooltip-offset-display 'lines)) ;; 'scrollbar + + :config + (defun jao-complete-at-point () + "Complete using company unless we're in the minibuffer." + (interactive) + (if (or (not company-mode) (window-minibuffer-p)) + (completion-at-point) + (company-manual-begin))) + + (defun jao-company-use-in-tab () + (global-set-key [remap completion-at-point] #'jao-complete-at-point) + (global-set-key [remap completion-symbol] #'jao-complete-at-point) + (global-set-key (kbd "M-TAB") #'jao-complete-at-point)) + + (jao-company-use-in-tab) + + :bind (:map company-active-map + + ("<tab>" . company-complete-common-or-cycle) + ("TAB" . company-complete-common-or-cycle) + + ("C-h" . company-show-doc-buffer) + ("M-." . company-show-location) + ("C-<return>" . company-complete-selection) + ([remap return] . company-abort) + ("RET" . company-abort) + + :filter (or (not (derived-mode-p 'eshell-mode)) + (company-explicit-action-p)) + ("<return>" . company-complete-selection) + ("RET" . company-complete-selection)) + :diminish) + +(unless (display-graphic-p) (global-company-mode 1)) + + +;;; eldoc for magit status/log buffers +(defun jao-magit-eldoc-for-commit (_callback) + (when-let ((commit (magit-commit-at-point))) + (with-temp-buffer + (magit-git-insert "show" + "--format=format:%an <%ae>, %ar" + (format "--stat=%d" (window-width)) + commit) + (goto-char (point-min)) + (put-text-property (point-min) (line-end-position) 'face 'bold) + (buffer-string)))) + +(defun jao-magit-eldoc-setup () + (add-hook 'eldoc-documentation-functions + #'jao-magit-eldoc-for-commit nil t) + (eldoc-mode 1)) + +(add-hook 'magit-log-mode-hook #'jao-magit-eldoc-setup) +(add-hook 'magit-status-mode-hook #'jao-magit-eldoc-setup) + +(with-eval-after-load "eldoc" + (eldoc-add-command 'magit-next-line) + (eldoc-add-command 'magit-previous-line) + (eldoc-add-command 'magit-section-forward) + (eldoc-add-command 'magit-section-backward)) + +;;; outline mode for notmuch tree view + +(defun jao-notmuch-tree--msg-prefix (msg) + (insert (propertize (if (plist-get msg :first) "> " " ") 'display " "))) + +(defun jao-notmuch-tree--mode-setup () + (setq-local outline-regexp "^> \\|^En") + (outline-minor-mode t)) + +(defun jao-notmuch-tree-hide-others (&optional and-show) + (interactive) + (outline-hide-body) + (outline-show-entry) + (when and-show (notmuch-tree-show-message nil))) + +(defsubst jao-notmuch-tree--message-open () + (and (buffer-live-p notmuch-tree-message-buffer) + (get-buffer-window notmuch-tree-message-buffer))) + +(defsubst jao-notmuch--get-prop (prop &optional props) + (or (and props (plist-get props prop)) + (notmuch-tree-get-prop prop) + (notmuch-show-get-prop prop))) + +(defun jao-notmuch--looking-at-match-p () + (and (jao-notmuch--get-prop :match) + (equal (jao-notmuch--get-prop :orig-tags) + (jao-notmuch--get-prop :tags)))) + +(defun jao-notmuch-tree--next (prev thread no-exit &optional ignore-new) + (let ((line-move-ignore-invisible nil)) + (cond ((and (not ignore-new) + (jao-notmuch--looking-at-match-p) + (not (jao-notmuch-tree--message-open)))) + (thread + (notmuch-tree-next-thread prev) + (unless (or (not (notmuch-tree-get-message-properties)) + (jao-notmuch--looking-at-match-p)) + (notmuch-tree-matching-message prev (not no-exit)))) + (t (notmuch-tree-matching-message prev (not no-exit))))) + (when (notmuch-tree-get-message-id) + (jao-notmuch-tree-hide-others t)) + (when prev (forward-char 2))) + +(defvar jao-notmuch-tree--prefix-map + (let ((m (make-keymap "Thread operations"))) + (define-key m (kbd "TAB") #'outline-cycle) + (define-key m (kbd "t") #'outline-toggle-children) + (define-key m (kbd "s") #'outline-show-entry) + (define-key m (kbd "S") #'outline-show-all) + (define-key m (kbd "h") #'outline-hide-entry) + (define-key m (kbd "H") #'outline-hide-body) + (define-key m (kbd "o") #'jao-notmuch-tree-hide-others) + (define-key m (kbd "n") #'outline-hide-other) + m)) + +(defun jao-notmuch-tree-outline-setup (&optional prefix) + (define-key notmuch-tree-mode-map (kbd (or prefix "T")) + jao-notmuch-tree--prefix-map) + (define-key notmuch-tree-mode-map (kbd "TAB") #'outline-cycle) + (define-key notmuch-tree-mode-map (kbd "M-TAB") #'outline-cycle-buffer) + (add-hook 'notmuch-tree-mode-hook #'jao-notmuch-tree--mode-setup) + (advice-add 'notmuch-tree-insert-msg :before #'jao-notmuch-tree--msg-prefix)) + +(defun jao-notmuch-tree-next (thread &optional no-exit) + "Next message or thread in forest, taking care of thread visibility." + (interactive "P") + (jao-notmuch-tree--next nil thread no-exit)) + +(defun jao-notmuch-tree-next-thread (&optional exit) + "Next thread in forest, taking care of thread visibility." + (interactive "P") + (jao-notmuch-tree--next nil t exit)) + +(defun jao-notmuch-tree-previous (thread) + "Previous message or thread in forest, taking care of thread visibility." + (interactive "P") + (jao-notmuch-tree--next t thread t)) + +(defun jao-notmuch-tree-previous-thread (&optional exit) + "Previous thread in forest, taking care of thread visibility." + (interactive "P") + (jao-notmuch-tree--next t t exit)) + + +;;; elpher/gemini +(use-package elpher :ensure t) +(defun jao-elpher--browse (url &rest _) (elpher-go url)) +(add-to-list 'browse-url-handlers + '("^\\(gemini\\|gopher\\)://.*" . jao-elpher--browse)) + +;;; fontsets +(defun jao--set-fontsets (_f) + (when (and (display-graphic-p) (fboundp 'set-fontset-font)) + (set-fontset-font t 64257 "Quivira" nil) + (set-fontset-font t 'egyptian "Noto Sans Egyptian Hieroglyphs" nil) + (set-fontset-font t 'hangul "NanumGothicCoding" nil) + (set-fontset-font t 'unicode (face-attribute 'default :family) nil) + (set-fontset-font t 'unicode-bmp (face-attribute 'default :family) nil) + (set-fontset-font t 'symbol "Symbola-10" nil) + (set-fontset-font t 'greek "GFS Didot" nil) + (set-fontset-font t 'mathematical "FreeSerif" nil) + (set-fontset-font t 'emoji "Noto Color Emoji" nil) + ;; boxes + (set-fontset-font t '(9472 . 9599) "Source Code Pro" nil) + ;; variation selector-16 + (set-fontset-font t 65039 "BabelStone Modern-1" nil))) + +(jao--set-fontsets nil) +(add-to-list 'after-make-frame-functions 'jao--set-fontsets) + +;;; eshell history completion to allow !$ +;; This is done by advising eshell-history-reference to expand !$ +;; into !!:$ which works... +(defadvice jao-eshell-history-reference (before ben-fix-eshell-history) + "Fixes eshell history to allow !$ as abbreviation for !!:$" + (when (string= (ad-get-arg 0) "!$") (ad-set-arg 0 "!!:$"))) +(ad-activate 'jao-eshell-history-reference) +(add-hook 'eshell-expand-input-functions #'eshell-expand-history-references) +;;; enwc +(use-package enwc + :ensure t + :custom ((enwc-default-backend 'nm) + (enwc-wired-device "wlp164s0") + (enwc-wireless-device "wlp164s0") + (enwc-display-mode-line nil))) + + +;;; tidal/mpc +(defconst jao-mpc--search-cmd + "-f '%%album%% - %%artist%% :::%%file%%' search %s '%s'|grep :::tidal:album") + +(defun jao-mpc--search-albums (query) + (let* ((cmd (format jao-mpc--search-cmd "any" query)) + (str (jao-mpc--cmd cmd)) + (res (split-string str "\n" t))) + (message "%s" str) + (mapcar (lambda (s) (split-string s ":::" t " ")) res))) + +(defun jao-mpc-select-tidal-album (&optional query port) + (interactive "sSearch terms: ") + (let* ((jao-mpc-port (or port jao-mpc-port)) + (resa (jao-mpc--search-albums query))) + (if (null resa) + (user-error "No results") + (when-let* ((a (completing-read "Play album: " resa nil t)) + (s (car (alist-get a resa nil nil 'string=)))) + (jao-mpc--add-and-play s port t))))) +;;; dogears +(use-package dogears + :ensure t + :enabled nil + :bind (:map global-map + ("M-g d" . dogears-go) + ("M-g M-b" . dogears-back) + ("M-g M-f" . dogears-forward) + ("M-g M-d" . dogears-list) + ("M-g M-D" . dogears-sidebar))) + +(dogears-mode) +;;; pulsar +(use-package pulsar + :ensure t + :demand t + :diminish + :custom ((pulsar-pulse t) + (pulsar-delay 0.1) + (pulsar-iterations 10) + (pulsar-face 'pulsar-yellow) + (pulsar-highlight-face 'jao-themes--hilite)) + :config + (dolist (f '(jao-prev-window + jao-tracking-next-buffer + smartscan-symbol-go-forward + smartscan-symbol-go-backward)) + (add-to-list 'pulsar-pulse-functions f)) + + :hook ((jao-afio-switch . pulsar-pulse-line) + (consult-after-jump . pulsar-reveal-entry) + (imenu-after-jump . pulsar-reveal-entry) + (next-error . pulsar-pulse-line))) + +(pulsar-global-mode 1) +;;;; mouse +(use-package disable-mouse + :ensure t + :diminish ((disable-mouse-global-mode . ""))) + +(global-disable-mouse-mode) +;;; tmr +(use-package tmr + :ensure t + :init + (setq tmr-sound-file "/usr/share/sounds/freedesktop/stereo/message.oga")) +;;; pdf-tools +(use-package pdf-tools + :ensure t + :demand t + :init + (add-hook 'after-init-hook + (lambda () + (setq pdf-view-midnight-colors + (cons (frame-parameter nil 'foreground-color) + (frame-parameter nil 'background-color))))) + + :hook ((pdf-view-mode . jao-doc-session-mark)) + + :config (pdf-tools-install) + + :diminish ((pdf-view-midnight-minor-mode . "")) + + :bind (:map pdf-view-mode-map + (("C-c C-d" . pdf-view-midnight-minor-mode) + ("j" . pdf-view-next-line-or-next-page) + ("J" . pdf-view-scroll-up-or-next-page) + ("k" . pdf-view-previous-line-or-previous-page) + ("K" . pdf-view-scroll-down-or-previous-page)))) +;;; slack +(eval-and-compile + (defvar jao-slack-dir (expand-file-name "emacs-slack" jao-local-lisp-dir))) + +(use-package slack + :commands (slack-start) + :vc t + :load-path jao-slack-dir + :init + (setq slack-alert-icon (jao-data-file "slack.svg") + slack-buffer-emojify nil + slack-buffer-create-on-notify t + slack-display-team-name t + slack-typing-visibility 'buffer ;; 'never, 'buffer, 'frame + slack-thread-also-send-to-room t + slack-profile-image-file-directory "/tmp/slack-imgs/" + slack-image-file-directory "/tmp/slack-imgs/" + slack-file-dir "~/var/download/slack/" + slack-prefer-current-team t + slack-message-tracking-faces '(warning) + slack-log-level 'warn + slack-message-custom-notifier (lambda (_msg room _team) room)) + :bind (:map slack-mode-map (("@" . slack-message-embed-mention) + ("#" . slack-message-embed-channel)) + :map slack-message-buffer-mode-map + (("C-c C-e" . slack-message-edit) + ("C-c C-a" . slack-file-upload))) + :hook ((slack-file-info-buffer-mode . view-mode)) + :config + + (defun my-slack-nobreak-mrkdwn () + "Return non-nil (don't break line) if point is in markdown code face." + (seq-find (lambda (ov) + (eq 'slack-mrkdwn-code-block-face (overlay-get ov 'face))) + (overlays-at (point)))) + (add-hook 'slack-message-buffer-mode-hook + (lambda () + (add-hook 'fill-nobreak-predicate #'my-slack-nobreak-mrkdwn + nil 'local))) + + (dolist (f (list slack-file-dir slack-image-file-directory)) + (when (not (file-exists-p f)) (make-directory f))) + + (jao-shorten-modes 'slack-message-buffer-mode + 'slack-thread-message-buffer-mode) + (jao-tracking-faces 'warning) + (jao-tracking-cleaner "logstash-\\([^-]+\\)-\\(.+\\)" "\\2-\\1") + (jao-tracking-cleaner + "^\\*Slack - .*? : \\(MPIM: \\)?\\([^ ]+\\)\\( \\(T\\)\\)?.*" "\\2\\4") + (jao-define-attached-buffer "\\*Slack .+ Edit Message [0-9].+" 20)) + +;;; alert +(use-package alert + :ensure t + :init + (setq alert-default-style 'message ;; 'libnotify + alert-hide-all-notifications nil)) +;;; snippets +(defun jao-org-notes-open-tags () + "Search for a note file, matching all tags with completion." + (let* ((tags (jao-org-notes--read-tags)) + (fn (lambda () + (prog1 (jao-org-notes--find-tag (car tags)) + (setq tags (cdr tags))))) + (res (funcall fn))) + (while (and res tags) (setq res (seq-intersection res (funcall fn)))) + (unless res (user-error "No notes found")) + (when-let (f (completing-read "Select file: " (mapcar #'car res))) + (find-file (cadr (assoc f res)))))) + +(defun jao-sway-run-or-focus-tidal () + (interactive) + (if (jao-shell-running-p "tidal-hifi") + (jao-swaymsg "[app_id=tidal-hifi] scratchpad show") + (let ((c + "tidal-hifi --enable-features=UseOzonePlatform --ozone-platform=wayland &")) + (start-process-shell-command "tidal-hifi" nil c)) + (jao-sway-run-or-focus-tidal))) + +;; + +(defun jao-afio--set-mode-line () + (when (and window-system (fboundp 'jao-mode-line-hide-inactive)) + (if (string= "docs" (jao-afio-frame-name)) + (jao-mode-line-show-inactive nil) + (jao-mode-line-hide-inactive nil)))) + +(unless jao-modeline-in-minibuffer + (add-hook 'jao-afio-switch-hook #'jao-afio--set-mode-line)) + +;; + +(defun jao-word-definition-lookup () + "Look up the word under cursor in a browser." + (interactive) + (require 'thingatpt) + (browse-url + (concat "http://www.wordnik.com/words/" + ;; "http://www.answers.com/main/ntquery?s=" + (thing-at-point 'word)))) + +;; + +(defun jao-notmuch-format-author (width msg) + (let* ((headers (plist-get msg :headers)) + (auth (notmuch-tree-clean-address (plist-get headers :From))) + (awidth (string-width auth)) + (auth (if (> awidth width) + (substring auth 0 width) + (concat auth (make-string (- width awidth) 32)))) + (face (if (plist-get msg :match) + 'notmuch-tree-match-author-face + 'notmuch-tree-no-match-author-face))) + (propertize auth 'face face))) diff --git a/attic/net/nnnm.el b/attic/elisp/nnnm.el index 552e95c..552e95c 100644 --- a/attic/net/nnnm.el +++ b/attic/elisp/nnnm.el diff --git a/attic/misc.org b/attic/misc.org deleted file mode 100644 index e84cad0..0000000 --- a/attic/misc.org +++ /dev/null @@ -1,22 +0,0 @@ -* dtache - #+begin_src emacs-lisp - (use-package dtache - :ensure t - :hook (after-init . dtache-setup)) - - (use-package dtache-eshell - :after dtache - :hook (eshell-mode . dtache-eshell-mode)) - - (use-package dtache-consult - :after (consult dtache) - :bind ([remap dtache-open-session] . dtache-consult-session)) - #+end_src -* signel - #+begin_src emacs-lisp :tangle no - (jao-load-org "lib/net/signel.org") - (with-eval-after-load "tracking" - (jao-tracking-faces 'signel-notification) - (jao-shorten-modes 'signel-chat-mode)) - (setq signel-report-deliveries t) - #+end_src diff --git a/attic/net/w3m.org b/attic/net/w3m.org deleted file mode 100644 index 3689c8e..0000000 --- a/attic/net/w3m.org +++ /dev/null @@ -1,191 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments no :results silent -#+title: Customizations for emacs-w3m -#+auto_tangle: t - -* browse-url and afio - #+begin_src emacs-lisp - (defun jao-w3m-find-url (url) - (let* ((url (w3m-canonicalize-url url)) - (fn `(lambda (b) - (with-current-buffer b - (string= ,url (w3m-canonicalize-url w3m-current-url)))))) - (when-let (b (seq-find fn (w3m-list-buffers))) - (pop-to-buffer b)))) - - (defun jao-w3m-browse-url (url &rest r) - (jao-afio--goto-www) - (select-window (frame-first-window)) - (or (jao-w3m-find-url url) - (w3m-goto-url-new-session url))) - - (defun jao-w3m-download (arg) - (interactive "P") - (jao-download (w3m-anchor) arg)) - - (setq jao-afio-use-w3m t) - (setq jao-browse-url-function 'jao-w3m-browse-url) - #+end_src -* Org integration - #+begin_src emacs-lisp - (defun jao-w3m-get-link () - (let ((wb (w3m-alive-p))) - (when wb - (let ((url (with-current-buffer wb w3m-current-url)) - (title (w3m-buffer-title wb))) - (cons url title))))) - - (defun jao-insert-w3m-link () - (interactive) - (let ((link (jao-w3m-get-link))) - (when link (insert "[[" (car link) "][" (cdr link) "]]")))) - - (with-eval-after-load "org" - (require 'ol-w3m nil t) - (define-key org-mode-map "\C-cW" 'jao-insert-w3m-link)) - #+end_src -* notmuch integration - #+begin_src emacs-lisp - (defvar-local jao-notmuch--showing-images nil) - - (defun jao-notmuch--setup-w3m-images (&optional activate) - (when (eq mm-text-html-renderer 'w3m) - (setq-local w3m-ignored-image-url-regexp - (unless jao-notmuch--showing-images - notmuch-show-text/html-blocked-images)) - (when activate - (setq-local scroll-margin 0) - (w3m-toggle-inline-images (if jao-notmuch--showing-images t 'turnoff))))) - - (defun jao-notmuch--w3m-toggle-images () - (save-window-excursion - (when (or (derived-mode-p 'notmuch-show-mode) - (jao-notmuch-goto-message-buffer nil t)) - (goto-char (point-min)) - (when (re-search-forward "^\\[ text/html " nil t) - (when (looking-at-p "(hidden)") - (notmuch-show-toggle-part-invisibility)) - (forward-line 1) - (setq jao-notmuch--showing-images (not jao-notmuch--showing-images)) - (jao-notmuch--setup-w3m-images t))))) - - (add-hook 'notmuch-show-mode-hook #'jao-notmuch--setup-w3m-images) - #+end_src -* Capture page - #+begin_src emacs-lisp - (defun jao-w3m-capture-page () - (interactive) - (let* ((title (w3m-current-title)) - (url w3m-current-url) - (html (y-or-n-p "Save as HTML (y) or PS (n)? ")) - (basename (concat (read-string "File name: ") - (if html ".html" ".ps"))) - (name (expand-file-name basename jao-sink-dir))) - (if html - (progn - (w3m-view-source) - (write-region (point-min) (point-max) name nil nil nil t) - (w3m-view-source)) - (progn - (split-window-horizontally 85) - (w3m-redisplay-this-page) - (ps-print-buffer name) - (delete-other-windows) - (w3m-redisplay-this-page))) - (kill-new (format "[[doc:%s][%s]] ([[%s][original]])" - basename title url)))) - #+end_src -* Consult narrowing - #+begin_src emacs-lisp - (with-eval-after-load "w3m-util" - (with-eval-after-load "consult" - (defvar jao-consult-w3m-buffer-history nil) - (defun jao-www--item (b) - (with-current-buffer b - (propertize (or w3m-current-title (buffer-name)) - 'buffer b - 'url (or w3m-current-url (buffer-name))))) - (defvar jao-consult-w3m-source - (list :name "www buffer" - :category 'www-buffer - :hidden t - :narrow (cons ?w "www") - :annotate (lambda (b) (when b (get-text-property 0 'url b))) - :history 'jao-consult-w3m-buffer-history - :items (lambda () - (seq-map #'jao-www--item - (seq-filter #'jao-www--buffer-p (buffer-list)))) - :action (lambda (b) - (jao-afio--goto-www) - (switch-to-buffer (get-text-property 0 'buffer b))))) - (jao-consult-add-buffer-source 'jao-consult-w3m-source "Web" ?w))) - #+end_src -* Package - #+begin_src emacs-lisp - (use-package w3m - :ensure t - :custom ((w3m-key-binding 'info) - (w3m-display-mode 'dual-pane)) - :init - (setq w3m-add-user-agent nil - w3m-confirm-leaving-secure-page nil - w3m-cookie-accept-bad-cookies t - w3m-cookie-accept-domains '(".github.com" - ".librarything.com" - ".goodreads.com" - ".sr.ht" - ".gnu.org" - ".codeberg.org" - "codeberg.org" - ".bookshop.org" - ".reddit.com") - w3m-cookie-reject-domains '(".") - w3m-default-save-directory "~/var/download" - w3m-do-cleanup-temp-files nil - w3m-external-view-temp-directory "/tmp" - w3m-fill-column 110 - w3m-goto-article-function 'jao-w3m-browse-url - w3m-form-input-textarea-buffer-lines 40 - w3m-history-minimize-in-new-session t - w3m-history-reuse-history-elements nil - w3m-image-no-idle-timer t - w3m-make-new-session t - w3m-profile-directory "~/.w3m" - w3m-redisplay-pages-automatically-p nil - w3m-resize-images t - w3m-safe-url-regexp nil - w3m-search-default-engine "duckduckgo" ; "google-en" - w3m-select-buffer-horizontal-window nil - w3m-select-buffer-window-ratio '(20 . 40) - w3m-session-load-last-sessions t - w3m-session-load-crashed-sessions 'ask - w3m-show-graphic-icons-in-header-line nil - w3m-show-graphic-icons-in-mode-line nil - w3m-use-tab nil - w3m-use-tab-line nil - w3m-use-title-buffer-name t - w3m-use-cookies t - w3m-use-filter nil - w3m-use-favicon nil - w3m-use-header-line nil - w3m-use-refresh nil - w3m-use-symbol t) - - :config - :bind (:map w3m-mode-map - (("+" . w3m-zoom-in-image) - ("-" . w3m-zoom-out-image) - ("C-c C-@" . tracking-next-buffer) - ("C-c C-SPC" . tracking-next-buffer) - ("C-c C-b" . nil) - ("C-c c" . jao-w3m-capture-page) - ("b" . w3m-view-previous-page) - ("B" . w3m-view-next-page) - ("c" . w3m-print-this-url) - ("d" . jao-w3m-download) - ("D" . w3m-download) - ("f" . w3m-lnum-follow) - ("v" . jao-view-video) - ("w" . org-w3m-copy-for-org-mode) - ("x" . jao-rss-subscribe) - ("y" . w3m-print-current-url)))) - #+end_src diff --git a/blog.org b/blog.org deleted file mode 100644 index 29b35f0..0000000 --- a/blog.org +++ /dev/null @@ -1,254 +0,0 @@ -#+title: Org static blog -#+property: header-args lexical: t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t -*-" :tangle-mode (identity #o644) -#+auto_tangle: t - -* Vars and setup - #+begin_src emacs-lisp - (jao-load-path "org-static-blog") - (when (> emacs-major-version 26) (use-package htmlize :ensure t)) - (defvar jao-blog-base-dir "~/doc/jao.io") - (defun jao-blog-dir (p) (expand-file-name p jao-blog-base-dir)) - - (setq jao-org-blog-tag-files - (seq-difference (directory-files (jao-blog-dir "blog") nil "tag-.*") - "tag-norss.html") - - jao-org-blog-tags - (mapcar (lambda (f) - (string-match "tag-\\(.+\\)\\.html" f) - (format "<a href=\"/blog/%s\">%s</a>" - f (match-string 1 f))) - jao-org-blog-tag-files) - - jao-org-blog-tag-rss - (mapcar (lambda (f) - (string-match "\\(.+\\)-rss\\.xml" f) - (format "<a href=\"/blog/%s\">%s</a>" - f (match-string 1 f))) - (directory-files (jao-blog-dir "blog") nil ".*-rss.xml")) - - jao-org-blog-tag-names - (mapcar (lambda (f) - (string-match "tag-\\(.+\\)\\.html" f) - (match-string 1 f)) - jao-org-blog-tag-files)) - #+end_src -* HTML headers and footers -*** Header - #+begin_src emacs-lisp - (setq org-static-blog-page-header - (concat - "<meta name=\"author\" content=\"jao\">\n" - "<meta name=\"referrer\" content=\"no-referrer\">\n" - "<link rel=\"stylesheet\" href=\"/static/style.css\"" - " type=\"text/css\">\n" - "<link rel=\"apple-touch-icon\" sizes=\"180x180\"" - " href=\"/static/apple-touch-icon.png\" >\n" - "<link rel=\"icon\" type=\"image/png\"" - " sizes=\"32x32\" href=\"/static/favicon-32x32.png\">\n" - "<link rel=\"icon\" type=\"image/png\"" - " sizes=\"16x16\" href=\"/static/favicon-16x16.png\">\n" - "<link rel=\"icon\" href=\"/static/favicon.ico\">\n" - "<link rel=\"manifest\" href=\"/static/site.webmanifest\">\n") - - org-static-blog-page-preamble - (concat - "<div class=\"header\">" - " <a href=\"https://jao.io\">programming (and other) musings</a>" - " <div class=\"sitelinks\">" - " <a href=\"/blog/about.html\">about</a>" - " | <a href=\"/blog/hacking.html\">hacking</a>" - " | <a href=\"/blog/archive.html\">archive</a>" - " | <div class=\"dropdown\">" - " <a href=\"/blog/tags.html\" class=\"dropbtn\">tags</a>" - " <div class=\"dropdown-content\">" - (mapconcat #'identity jao-org-blog-tags "") - " </div>" - " </div>" - " | <div class=\"dropdown\">" - " <a href=\"/blog/rss.xml\" class=\"dropbtn\">rss</a>" - " <div class=\"dropdown-content\">" - (mapconcat #'identity jao-org-blog-tag-rss "") - " </div>" - " </div>" - " </div>" - "</div>")) - #+end_src -*** Footer - #+begin_src html :tangle ~/.emacs.d/commons.html :comments no :shebang "" - <center> - <a rel="license" href="https://creativecommons.org/licenses/by-sa/3.0/"> - <img alt="Creative Commons License" style="border-width:0" - src="https://i.creativecommons.org/l/by-sa/3.0/88x31.png" /> - </a> - <br /> - <span xmlns:dct="https://purl.org/dc/terms/" - href="https://purl.org/dc/dcmitype/Text" property="dct:title" - rel="dct:type">jao.io</span> by - <a xmlns:cc="https://creativecommons.org/ns#" href="https://jao.io" - property="cc:attributionName" rel="cc:attributionURL">jao</a> - is licensed under a - <a rel="license" href="https://creativecommons.org/licenses/by-sa/3.0/"> - Creative Commons Attribution-ShareAlike 3.0 Unported License</a>. - </center> - #+end_src - - #+begin_src emacs-lisp - (setq org-static-blog-page-postamble - (with-temp-buffer - (insert-file-contents "~/.emacs.d/commons.html") - (buffer-string))) - #+end_src -* Package - #+begin_src emacs-lisp - (use-package org-static-blog - :ensure t - :init - (setq org-static-blog-use-preview t - org-static-blog-preview-link-p t - org-static-blog-preview-start "<!-- preview-start -->" - org-static-blog-preview-end "<!-- preview-end -->" - org-static-blog-preview-date-first-p t - org-static-blog-index-length 30 - org-static-blog-preview-convert-titles t - org-static-blog-preview-ellipsis "more ..." - org-static-blog-enable-tags t - org-static-blog-tags-file "tags.html" - org-static-blog-rss-file "rss.xml" - org-static-blog-publish-url "https://jao.io/blog/" - org-static-blog-publish-title "programming (and other) musings" - org-static-blog-posts-directory (jao-blog-dir "posts/") - org-static-blog-drafts-directory (jao-blog-dir "pages/") - org-static-blog-publish-directory (jao-blog-dir "blog/") - org-static-blog-rss-extra "" ; "<author>mail@jao.io</author>\n" - org-static-blog-rss-max-entries 30 - org-static-blog-rss-excluded-tag "norss" - org-static-blog-enable-tag-rss t - org-export-with-toc nil - org-export-with-section-numbers nil) - - :config - (defun jao-org-static-post-path (pf dt) - (cond ((string-match-p "pages/.*\\|in-no-particular-order" pf) - (file-name-nondirectory pf)) - ((string-match-p "drafts/.*" pf) pf) - ((string-match-p "^[[:digit:]]+-.*" pf) pf) - (t (concat (format-time-string "%Y-%m-%d-" dt) - (file-name-nondirectory pf))))) - (advice-add 'org-static-blog-generate-post-path :override - #'jao-org-static-post-path) - - :bind (:map org-mode-map (("C-c B" . jao-transient-org-blog)))) - #+end_src -* Commands -*** New entries - #+begin_src emacs-lisp - (defun jao-org-blog-publish-file (fname) - (interactive (list (read-file-name "Publish: " - nil - (buffer-file-name) - t - (buffer-file-name)))) - (let ((geiser-active-implementations '(guile)) - (geiser-default-implementation 'guile)) - (org-static-blog-publish-file fname))) - - (defconst jao-org-static-blog--prev-beg - "#+begin_export html\n <!-- preview-start -->\n#+end_export ") - - (defconst jao-org-static-blog--prev-end - "#+begin_export html\n <!-- preview-end -->\n#+end_export ") - - (defun jao-org-static-blog-create-new-post (&optional draft) - (interactive) - (let* ((title (read-string "Title: ")) - (file (replace-regexp-in-string "\s" "-" (downcase title))) - (tags (completing-read-multiple "Tags: " jao-org-blog-tag-names))) - (find-file (expand-file-name (concat file ".org") - (if draft - org-static-blog-drafts-directory - org-static-blog-posts-directory))) - (insert "#+title: " title "\n" - "#+date: " (format-time-string "<%Y-%m-%d %H:%M>") "\n" - "#+filetags: " - (mapconcat #'identity tags " ") - "\n\n") - (when (member "books" tags) - (insert jao-org-static-blog--prev-beg - "\n\n[[https://jao.io/img/" file ".jpg]]\n\n")) - (save-excursion (insert jao-org-static-blog--prev-end "\n")))) - #+end_src -*** Drafts - #+begin_src emacs-lisp - (defun jao-org-static-blog-update-date () - (interactive) - (when (y-or-n-p "Update date? ") - (goto-char (point-min)) - (when (re-search-forward "^#\\+date: " nil t) - (let ((kill-whole-line nil)) (kill-line)) - (insert (format-time-string "<%Y-%m-%d %H:%M>")) - (save-buffer)))) - - (defun jao-org-static-blog-create-new-draft () - (interactive) - (jao-org-static-blog-create-new-post t)) - - (defun jao-org-static-blog-publish-draft () - (interactive) - (let* ((from (read-file-name "Post: " - org-static-blog-drafts-directory - nil t)) - (to (expand-file-name (file-name-nondirectory from) - org-static-blog-posts-directory))) - (rename-file from to) - (when-let ((b (get-buffer from))) - (kill-buffer b)) - (find-file to) - (jao-org-static-blog-update-date) - (when (y-or-n-p "Generate HTML? ") - (jao-org-blog-publish)))) - - (defun jao-org-static-blog-edit-draft () - (interactive) - (find-file (read-file-name "Edit: " - org-static-blog-drafts-directory - nil - t))) - #+end_src -*** Publish - #+begin_src emacs-lisp - (defun jao-org-blog-publish (&optional force) - (interactive "P") - (let ((geiser-active-implementations '(guile)) - (geiser-default-implementation 'guile)) - (org-static-blog-publish force))) - - (defun jao-org-blog-republish () - (interactive) - (jao-org-blog-publish t)) - #+end_src -* Transient - #+begin_src emacs-lisp - (defun jao-org-static-prev-begin () - (interactive) - (insert jao-org-static-blog--prev-beg)) - - (defun jao-org-static-prev-end () - (interactive) - (insert jao-org-static-blog--prev-end)) - - (jao-transient-major-mode+ org - ["Insert blog snippet" - ("s" "preview begin" jao-org-static-prev-begin) - ("S" "preview end" jao-org-static-prev-end) - ("T" "update date" jao-org-static-blog-update-date)] - ["Edit blog" - ("n" "create post" jao-org-static-blog-create-new-post) - ("d" "create draft" jao-org-static-blog-create-new-draft) - ("e" "edit draft" jao-org-static-blog-edit-draft)] - ["Publish blog" - ("D" "publish draft" jao-org-static-blog-publish-draft) - ("f" "publish single file" jao-org-blog-publish-file) - ("p" "publish all" jao-org-blog-publish) - ("r" "republish" jao-org-blog-republish)]) - #+end_src diff --git a/completion.org b/completion.org deleted file mode 100644 index ad35b9a..0000000 --- a/completion.org +++ /dev/null @@ -1,654 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t -*-" :tangle-mode (identity #o644) -#+title: Completion configuration -#+auto_tangle: t - -* imenu - #+begin_src emacs-lisp - (use-package imenu - :init (setq org-imenu-depth 7) - :config - (defun jao-imenu-hook () - (cond ((derived-mode-p 'org-mode) (org-reveal t)) - (outline-minor-mode (outline-show-entry)))) - (add-hook 'imenu-after-jump-hook #'jao-imenu-hook)) - #+end_src -* completion styles -*** completion configuration - #+begin_src emacs-lisp - (setq tab-always-indent 'complete - read-extended-command-predicate #'command-completion-default-include-p - completion-category-defaults nil - completion-cycle-threshold nil - completions-detailed t - completion-show-help nil - completion-show-inline-help nil - completion-ignore-case t - completion-wrap-movement t - completion-auto-select nil - completions-format 'one-column - completion-styles '(basic substring partial-completion emacs22) - completion-category-overrides - '((file (styles partial-completion)) - (command (styles initials substring partial-completion)) - (symbol (styles initials substring partial-completion)) - (variable (styles initials substring partial-completion)))) - - ;; (setq completions-sort #'jao-completion--sort-by-length-alpha) - (setq completions-sort #'jao-completion--sort-by-history) - - (defun jao-completion--sort-by-alpha-length (elems) - (sort elems (lambda (c1 c2) - (or (string-version-lessp c1 c2) - (< (length c1) (length c2)))))) - - (defun jao-completion--sort-by-history (elems) - (let ((hist (and (not (eq minibuffer-history-variable t)) - (symbol-value minibuffer-history-variable)))) - (if hist - (minibuffer--sort-by-position hist elems) - (jao-completion--sort-by-alpha-length elems)))) - - #+end_src -*** crm indicator - #+begin_src emacs-lisp - (defun jao-completion--crm-indicator (args) - "Add prompt indicator to `completing-read-multiple' filter ARGS." - (cons (concat "[CRM] " (car args)) (cdr args))) - (advice-add #'completing-read-multiple - :filter-args #'jao-completion--crm-indicator) - #+end_src -*** directory navigation - #+begin_src emacs-lisp - (defun jao-completion-backward-updir () - "Delete char before point or go up a directory." - (interactive nil mct-minibuffer-mode) - (cond ((and (eq (char-before) ?/) - (eq (mct--completion-category) 'file)) - (when (string-equal (minibuffer-contents) "~/") - (delete-minibuffer-contents) - (insert (expand-file-name "~/")) - (goto-char (line-end-position))) - (save-excursion - (goto-char (1- (point))) - (when (search-backward "/" (minibuffer-prompt-end) t) - (delete-region (1+ (point)) (point-max))))) - (t (call-interactively 'backward-delete-char)))) - - (define-key minibuffer-local-filename-completion-map (kbd "DEL") - #'jao-completion-backward-updir) - #+end_src -* orderless - #+begin_src emacs-lisp - (use-package orderless - :ensure t - :init - (setq completion-styles '(substring partial-completion orderless)) - :config - (orderless-define-completion-style orderless+initialism - (orderless-matching-styles '(orderless-initialism - orderless-prefixes - orderless-literal - orderless-regexp))) - (setq completion-category-overrides - '((file (styles partial-completion orderless)) - (command (styles orderless+initialism))) - orderless-matching-styles - '(orderless-literal orderless-regexp orderless-prefixes))) - - #+end_src -* marginalia - #+begin_src emacs-lisp - (use-package marginalia - :ensure t - :bind (:map minibuffer-local-map ("C-M-a" . marginalia-cycle)) - - :custom ((marginalia-align 'left) - (marginalia-align-offset 1) - (marginalia-field-width 200) - (marginalia-annotators - '(marginalia-annotators-heavy marginalia-annotators-light nil)) - (marginalia-separator " "))) - - (marginalia-mode 1) - #+end_src -* corfu - #+begin_src emacs-lisp - (use-package corfu - :ensure t - :demand t - :init (setq corfu-echo-documentation 0.25 - corfu-cycle t - corfu-count 15 - corfu-quit-no-match t - corfu-auto t - corfu-commit-predicate nil - corfu-preview-current nil - corfu-preselect-first t - corfu-min-width 20 - corfu-max-width 100) - :config - - ;; show eldoc string immediately after accepted completion too - (with-eval-after-load "eldoc" - (eldoc-add-command-completions "corfu-")) - - (defun jao-corfu-enable-no-auto () - (setq-local corfu-auto nil) - (corfu-mode 1)) - - (defmacro jao-corfu-no-auto (mode) - (let ((mode-name (intern (format "%s-mode" mode))) - (hook-name (intern (format "%s-mode-hook" mode)))) - `(with-eval-after-load ',mode - (add-to-list 'corfu-excluded-modes ',mode-name) - (add-hook ',hook-name #'jao-corfu-enable-no-auto)))) - - (jao-corfu-no-auto eshell) - ;; (add-to-list 'corfu-excluded-modes 'notmuch-message-mode) - - (defun jao-corfu--active-p () - (and (>= corfu--index 0) (/= corfu--index corfu--preselect))) - - (defun jao-corfu-quit-or-insert () - (interactive) - (if (jao-corfu--active-p) (corfu-insert) (corfu-quit))) - - (defun jao-corfu-quit-or-previous () - (interactive) - (if (jao-corfu--active-p) - (corfu-previous) - (corfu-quit) - (previous-line))) - - :bind (:map corfu-map - ("C-<return>" . corfu-insert) - ("\r" . jao-corfu-quit-or-insert) - ("C-p" . jao-corfu-quit-or-previous))) - - (defun corfu-in-minibuffer () - "Enable Corfu in the minibuffer only if vertico is not active." - (when (and window-system (not (bound-and-true-p vertico--input))) - (corfu-mode 1))) - - (add-hook 'minibuffer-setup-hook #'corfu-in-minibuffer 1) - (global-corfu-mode 1) - - #+end_src -* vertico - #+begin_src emacs-lisp - (use-package vertico - :ensure t - :init - (setq vertico-count 20 - vertico-cycle t - vertico-resize t - org-refile-use-outline-path t) - - :config - - (setq completion-in-region-function - (lambda (&rest args) - (apply (if (and (not window-system) vertico-mode) - #'consult-completion-in-region - #'completion--in-region) - args))) - - (defun jao-vertico--display-candidates (lines) - (move-overlay vertico--candidates-ov (point-min) (point-min)) - (overlay-put vertico--candidates-ov 'after-string (apply #'concat lines)) - (vertico--resize-window (length lines))) - - (advice-add 'vertico--display-candidates - :override #'jao-vertico--display-candidates)) - - (use-package vertico-directory - :after vertico - :bind (:map vertico-map (("RET" . vertico-directory-enter) - ("M-<backspace>" . vertico-directory-delete-word) - ("<backspace>" . vertico-directory-delete-char)))) - - (vertico-mode) - - #+end_src -* consult -*** package - #+begin_src emacs-lisp - (use-package consult - :ensure t - :bind (("C-x M-:" . consult-complex-command) - ("C-x b" . consult-buffer) - ("C-x C-b" . consult-buffer) - ("C-x 4 b" . consult-buffer-other-window) - ("C-c b" . project-find-file) - ("C-c h" . consult-history) - ("C-c i" . consult-imenu) - ("C-c I" . consult-project-imenu) - ("C-c k" . consult-ripgrep) - ("C-c K" . consult-git-grep) - ("C-c L" . consult-locate) - ;; ("C-h m" . consult-mode-command) - ("C-c s" . consult-line) - ("C-x r x" . consult-register) - ("C-x r b" . consult-bookmark) - ("C-x C-f" . jao-find-file) - ("M-g b" . consult-bookmark) - ("M-g m" . consult-mark) - ("M-g e" . consult-error) - ("M-s m" . consult-multi-occur) - ("M-s o" . consult-outline) - ("M-y" . consult-yank-pop) - ("C-s" . isearch-forward) - ("C-S-s" . consult-line) - ("<help> a" . consult-apropos)) - - :custom ((consult-preview-key (kbd "`"))) - - :init - (fset 'multi-occur #'consult-multi-occur) - - :config - - (defun jao-find-file (arg) - (interactive "P") - (call-interactively (if arg 'consult-file-externally 'find-file))) - - (define-key consult-narrow-map (vconcat consult-narrow-key "?") - #'consult-narrow-help) - - (consult-customize consult-mark :preview-key 'any) - (add-hook 'completion-list-mode-hook #'consult-preview-at-point-mode)) - - #+end_src -*** consult-dir - #+begin_src emacs-lisp - (use-package consult-dir - :ensure t - :bind (("C-x C-d" . consult-dir) - :map minibuffer-local-completion-map - (("C-x C-d" . consult-dir) - ("C-x C-j" . consult-dir-jump-file)))) - #+end_src -*** dh-diff hunks - #+begin_src emacs-lisp - (defun jao-consult--diff-lines (&optional backward) - (let ((candidates) - (width (length (number-to-string - (line-number-at-pos (point-max) - consult-line-numbers-widen))))) - (save-excursion - (while (ignore-errors (diff-hl-next-hunk backward)) - (let* ((str (buffer-substring (line-beginning-position) - (line-end-position))) - (no (line-number-at-pos (point))) - (no (consult--line-number-prefix (point-marker) no width))) - (push (concat no str) candidates)))) - (if backward candidates (nreverse candidates)))) - - (defun jao-consult-hunks () - (interactive) - (let ((candidates (append (jao-consult--diff-lines) - (jao-consult--diff-lines t)))) - (unless candidates (error "No changes!")) - (consult--jump - (consult--read candidates - :prompt "Go to hunk: " - :category 'consult--encode-location - :sort nil - :require-match t - :lookup #'consult--line-match - :state (consult--jump-state))))) - - (with-eval-after-load "consult" - (consult-customize '((jao-consult-hunks :preview-key any))) - (global-set-key (kbd "C-x v c") #'jao-consult-hunks)) - #+end_src -*** narrow helpers - #+begin_src emacs-lisp - (defvar jao-consult-narrow nil) - - (defun jao-consult-initial-narrow () - (when-let (c (cond ((eq this-command #'consult-buffer) - (cdr (assoc (jao-afio-current-frame) - jao-consult-narrow))) - ((eq this-command #'consult-mode-command) ?m))) - (setq unread-command-events (append unread-command-events `(,c 32))))) - - (add-hook 'minibuffer-setup-hook #'jao-consult-initial-narrow) - - (defmacro jao-consult--mode-buffers (&rest modes) - `(lambda () - (seq-map #'buffer-name - (seq-filter (lambda (b) - (with-current-buffer b - (derived-mode-p ,@modes))) - (buffer-list))))) - - (defun jao-consult-add-buffer-source (src &optional aframe key) - (add-to-list 'consult-buffer-sources src t) - (when (and aframe key) - (add-to-list 'jao-consult-narrow (cons aframe key)))) - #+end_src -*** narrowing chats - #+begin_src emacs-lisp - (defvar jao-chat-buffer-source - (list :name "chats" - :category 'buffer - :action #'pop-to-buffer - :hidden t - :narrow (cons ?c "chats") - :items (jao-consult--mode-buffers 'erc-mode - 'circe-channel-mode - 'circe-query-mode - 'signel-chat-mode - 'slack-message-buffer-mode - 'slack-thread-message-buffer-mode - 'telega-root-mode - 'telega-chat-mode))) - (with-eval-after-load "consult" - (jao-consult-add-buffer-source 'jao-chat-buffer-source)) - #+end_src - -*** exwm - #+begin_src emacs-lisp :tangle no - (with-eval-after-load "exwm" - (defun consult-exwm-preview-fix (&rest _args) - "Kludge to stop EXWM buffers from stealing focus during Consult previews." - (when-let ((mini (active-minibuffer-window))) - (select-window (active-minibuffer-window)))) - - (advice-add #'consult--buffer-action :after #'consult-exwm-preview-fix)) - - #+end_src -* embark -*** package - #+begin_src emacs-lisp - (use-package embark - :ensure t - :demand t - :init - (setq embark-quit-after-action nil - embark-indicator #'embark-mixed-indicator - embark-verbose-indicator-buffer-sections '(bindings) - embark-mixed-indicator-both t - embark-verbose-indicator-excluded-commands - '(embark-become embark-export embark-collect) - embark-verbose-indicator-nested t - embark-verbose-indicator-display-action - '((display-buffer-at-bottom) - (window-parameters (mode-line-format . none)) - (window-height . fit-window-to-buffer))) - - :bind (("C-;" . embark-act) - ("C-c ;" . embark-act) - ("C-'" . embark-dwim) - ("C-c '" . embark-dwim) - (:map minibuffer-local-map - (("C-'" . embark-dwim) - ("C-c '" . embark-dwim) - ("C-," . embark-become) - ("C-c ," . embark-become) - ("C-o" . embark-export))))) - - (use-package embark-consult - :ensure t - :after (embark consult)) - - (with-eval-after-load 'consult - (with-eval-after-load 'embark - (require 'embark-consult))) - - #+end_src -*** randomsig - #+begin_src emacs-lisp - (defun jao-random-sig-read (_ignored) - "Import region as signature and edit it." - (randomsig-message-read-sig t)) - - (define-key embark-region-map "m" #'jao-random-sig-read) - (define-key embark-region-map "M" #'apply-macro-to-region-lines) - #+end_src -*** dict/say - #+begin_src emacs-lisp - (defun jao-say (&optional word) - "Isn't it nice to have a computer that can talk to you?" - (interactive "sWhat? ") - (shell-command-to-string (format "say %s" word)) - "") - - (define-key embark-identifier-map "D" #'dictionary-search) - (define-key embark-identifier-map "S" #'jao-say) - #+end_src -*** org targets - #+begin_src emacs-lisp - (declare-function org-link-any-re "ol") - (declare-function org-open-link-from-string "ol") - (declare-function org-in-regexp "org-macs") - - (defun jao-embark-targets--org-link () - (when (derived-mode-p 'org-mode) - (when (org-in-regexp org-link-bracket-re) - (let ((lnk (match-string-no-properties 1))) - (if (string-match-p "https?://.+" (or lnk "")) - (cons 'url lnk) - (cons 'org-link (match-string-no-properties 0))))))) - - (embark-define-keymap jao-embark-targets-org-link-map - "Actions for org links" - ((kbd "RET") org-open-link-from-string)) - - (defun jao-embark-targets--gl-org-link () - (when (org-in-regexp org-link-bracket-re) - (cons 'gl-org-link (match-string-no-properties 0)))) - - (embark-define-keymap jao-embark-targets-gl-org-link-map - "Actions for exteranl org links" - ((kbd "RET") org-open-at-point-global)) - - (add-to-list 'embark-target-finders #'jao-embark-targets--gl-org-link) - (add-to-list 'embark-keymap-alist - '(gl-org-link . jao-embark-targets-gl-org-link-map)) - - (add-to-list 'embark-target-finders #'jao-embark-targets--org-link) - (add-to-list 'embark-keymap-alist - '(org-link . jao-embark-targets-org-link-map)) - - #+end_src -*** url targets - #+begin_src emacs-lisp - (declare-function w3m-anchor "w3m") - - (defun jao-embark-targets--w3m-anchor () - (when (not (region-active-p)) - (when-let ((url (or (jao-url-around-point) - (thing-at-point 'url) - (and (derived-mode-p 'w3m-mode) - (or (w3m-anchor) w3m-current-url)) - (and (derived-mode-p 'eww-mode) - (eww-current-url))))) - (when (string-match-p "^https?.*" url) - (cons 'url url))))) - - (add-to-list 'embark-target-finders #'jao-embark-targets--w3m-anchor) - - (defun jao-embark-url (url) - "Browse URL, externally if we're already in an emacs browser." - (if (derived-mode-p 'w3m-mode 'eww-mode) - (jao-browse-with-external-browser url) - (browse-url url))) - - (define-key embark-url-map (kbd "RET") #'jao-embark-url) - (define-key embark-url-map (kbd "f") #'browse-url-firefox) - (define-key embark-url-map (kbd "x") #'jao-rss-subscribe) - (define-key embark-url-map (kbd "m") 'jao-browse-with-external-browser) - (define-key embark-url-map (kbd "p") 'jao-browse-add-url-to-mpc) - - #+end_src -*** video url targets - #+begin_src emacs-lisp - (defvar jao-embark-targets-video-sites - '("youtu.be" "youtube.com" "blip.tv" "vimeo.com" "infoq.com")) - - (defun jao-embark--video-url-rx (&optional sites) - (format "^https?://\\(?:www\\.\\)?%s/.+" - (regexp-opt (or sites jao-embark-targets-video-sites) t))) - - (defvar jao-embark-targets-video-url-rx (jao-embark--video-url-rx) - "A regular expression matching URLs that point to video streams") - - (defun jao-embark-targets--refine-url (_ url) - (if (string-match-p jao-embark-targets-video-url-rx url) - (cons 'video-url url) - (cons 'url url))) - - (defun jao-embark-targets--play-video (player url) - (interactive "sURL: ") - (let ((cmd (format "%s %s" player (shell-quote-argument url)))) - (jao-afio--goto-www) - (start-process-shell-command player nil cmd))) - - (defun jao-embark-targets-mpv (&optional url) - "Play video stream with mpv" - (interactive "sURL: ") - (jao-embark-targets--play-video "mpv" url)) - - (defun jao-embark-targets-vlc (&optional url) - "Play video stream with vlc" - (interactive "sURL: ") - (jao-embark-targets--play-video "vlc" url)) - - (embark-define-keymap jao-embark-targets-video-url-map - "Actions on URLs pointing to remote video streams." - :parent embark-url-map - ("v" jao-embark-targets-vlc) - ("RET" jao-embark-targets-mpv)) - - (add-to-list 'embark-transformer-alist '(url . jao-embark-targets--refine-url)) - (add-to-list 'embark-keymap-alist '(video-url . jao-embark-targets-video-url-map)) - (define-key embark-url-map "v" #'jao-embark-targets-vlc) - (define-key embark-url-map "V" #'jao-embark-targets-vlc) - - #+end_src -*** spotify - #+begin_src emacs-lisp - (with-eval-after-load "consult-spotify" - (defun jao-consult-spt-play (candidate) - (when-let (url (espotify-candidate-url candidate)) - (jao-spt-play-uri url))) - - (embark-define-keymap spotify-item-keymap - "Actions for Spotify search results" - ("s" jao-consult-spt-play) - ("y" espotify-yank-candidate-url) - ("a" espotify-play-candidate-album) - ("h" espotify-show-candidate-info)) - - (add-to-list 'embark-keymap-alist - '(spotify-search-item . spotify-item-keymap))) - #+end_src -* avy and link hints - [[https://karthinks.com/software/avy-can-do-anything/][Avy can do anything | Karthinks]] - #+begin_src emacs-lisp - (use-package avy - :ensure t - :init (setq avy-style 'pre - avy-background t - avy-timeout-seconds 0.6 - avy-single-candidate-jump t) - - :config - - (defun avy-embark-act (pt) - "Use Embark to act on the completion at PT." - (save-excursion - (goto-char pt) - (embark-act))) - (add-to-list 'avy-dispatch-alist '(?\; . avy-embark-act)) - - :bind (("s-j" . avy-goto-char-timer) - ("C-M-j" . avy-goto-char-timer))) - - (use-package link-hint - :ensure t - :init (setq link-hint-avy-style 'pre) - - :config - (defun jao-link-hint-open-link-ext () - (interactive) - (let ((jao-browse-url-function jao-browse-url-external-function)) - (link-hint-open-link))) - - :bind (("C-l" . link-hint-open-link) - ("C-S-l" . jao-link-hint-open-link-ext) - ("C-x C-l" . recenter-top-bottom))) - - #+end_src -* recoll - #+begin_src emacs-lisp - (jao-load-path "consult-recoll") - - (defun jao-recoll-format (title url mtype) - (let* ((u (replace-regexp-in-string "/home/jao/" "" url)) - (u (replace-regexp-in-string - "\\(doc\\|org/doc\\|.emacs.d/gnus/Mail\\|var/mail\\)/" "" u))) - (format "%s (%s, %s)" - title - (propertize u 'face 'jao-themes-f00) - (propertize mtype 'face 'jao-themes-f01)))) - - (defun jao-recoll-open-html (file) - (jao-afio--goto-www) - (eww-open-file file)) - - (defun jao-recoll-consult-messages () - (interactive) - (consult-recoll "mime:message ")) - - (defun jao-recoll-consult-docs () - (interactive) - (consult-recoll (format "dir:%s/doc " jao-org-dir))) - - (defun jao-recoll-messages () - (interactive) - (jao-recoll "mime:message ")) - - (defun jao-recoll-docs () - (interactive) - (jao-recoll (format "dir:%s/doc " jao-org-dir))) - - (defun jao-recoll-notes () - "Use consult-recoll to search notes." - (interactive) - (jao-recoll (format "dir:%s " jao-org-notes-dir))) - - (defun jao-recoll-open-with-notmuch (fname) - (let ((id (with-temp-buffer - (insert-file fname) - (goto-char (point-min)) - (when (re-search-forward "[Mm]essage-[Ii][Dd]: <?\\([^><]+\\)>?" - nil t) - (match-string 1))))) - (when id (notmuch-show (concat "id:" id))))) - - (use-package consult-recoll - :init (setq consult-recoll-open-fns - '(("application/pdf" . jao-open-doc) - ("message/rfc822" . jao-recoll-open-with-notmuch) - ("text/html" . jao-recoll-open-html)) - consult-recoll-search-flags nil - consult-recoll-format-candidate #'jao-recoll-format) - :config - (transient-define-prefix jao-recoll-transient () - [["Consult recoll queries" - ("r" "consult recoll query" consult-recoll) - ("n" "consult recoll on notes" jao-org-notes-consult-recoll) - ("d" "consult recoll on docs" jao-recoll-consult-docs) - ("m" "consult recoll on messages" jao-recoll-consult-messages)] - ["Recoll queries" - ("R" "recoll query" jao-recoll) - ("N" "recoll on notes" jao-recoll-notes) - ("D" "consult recoll on docs" jao-recoll-docs) - ("M" "consult recoll on messages" jao-recoll-messages)]]) - - :bind (("s-r" . #'jao-recoll-transient))) - - #+end_src diff --git a/custom/jao-custom-blog.el b/custom/jao-custom-blog.el new file mode 100644 index 0000000..a11c5c0 --- /dev/null +++ b/custom/jao-custom-blog.el @@ -0,0 +1,225 @@ +;; -*- lexical-binding: t -*- + +;;; Vars and setup +(jao-load-path "org-static-blog") +(when (> emacs-major-version 26) (use-package htmlize :ensure t)) +(defvar jao-blog-base-dir "~/doc/jao.io") +(defun jao-blog-dir (p) (expand-file-name p jao-blog-base-dir)) + +(setq jao-org-blog-tag-files + (seq-difference (directory-files (jao-blog-dir "blog") nil "tag-.*") + "tag-norss.html") + + jao-org-blog-tags + (mapcar (lambda (f) + (string-match "tag-\\(.+\\)\\.html" f) + (format "<a href=\"/blog/%s\">%s</a>" + f (match-string 1 f))) + jao-org-blog-tag-files) + + jao-org-blog-tag-rss + (mapcar (lambda (f) + (string-match "\\(.+\\)-rss\\.xml" f) + (format "<a href=\"/blog/%s\">%s</a>" + f (match-string 1 f))) + (directory-files (jao-blog-dir "blog") nil ".*-rss.xml")) + + jao-org-blog-tag-names + (mapcar (lambda (f) + (string-match "tag-\\(.+\\)\\.html" f) + (match-string 1 f)) + jao-org-blog-tag-files)) + +;;; Header +(setq org-static-blog-page-header + (concat + "<meta name=\"author\" content=\"jao\">\n" + "<meta name=\"referrer\" content=\"no-referrer\">\n" + "<link rel=\"stylesheet\" href=\"/static/style.css\"" + " type=\"text/css\">\n" + "<link rel=\"apple-touch-icon\" sizes=\"180x180\"" + " href=\"/static/apple-touch-icon.png\" >\n" + "<link rel=\"icon\" type=\"image/png\"" + " sizes=\"32x32\" href=\"/static/favicon-32x32.png\">\n" + "<link rel=\"icon\" type=\"image/png\"" + " sizes=\"16x16\" href=\"/static/favicon-16x16.png\">\n" + "<link rel=\"icon\" href=\"/static/favicon.ico\">\n" + "<link rel=\"manifest\" href=\"/static/site.webmanifest\">\n") + + org-static-blog-page-preamble + (concat + "<div class=\"header\">" + " <a href=\"https://jao.io\">programming (and other) musings</a>" + " <div class=\"sitelinks\">" + " <a href=\"/blog/about.html\">about</a>" + " | <a href=\"/blog/hacking.html\">hacking</a>" + " | <a href=\"/blog/archive.html\">archive</a>" + " | <div class=\"dropdown\">" + " <a href=\"/blog/tags.html\" class=\"dropbtn\">tags</a>" + " <div class=\"dropdown-content\">" + (mapconcat #'identity jao-org-blog-tags "") + " </div>" + " </div>" + " | <div class=\"dropdown\">" + " <a href=\"/blog/rss.xml\" class=\"dropbtn\">rss</a>" + " <div class=\"dropdown-content\">" + (mapconcat #'identity jao-org-blog-tag-rss "") + " </div>" + " </div>" + " </div>" + "</div>")) + +;;; Footer +(setq org-static-blog-page-postamble + (with-temp-buffer + (insert-file-contents "~/.emacs.d/commons.html") + (buffer-string))) + +;;; Package +(use-package org-static-blog + :ensure t + :init + (setq org-static-blog-use-preview t + org-static-blog-preview-link-p t + org-static-blog-preview-start "<!-- preview-start -->" + org-static-blog-preview-end "<!-- preview-end -->" + org-static-blog-preview-date-first-p t + org-static-blog-index-length 30 + org-static-blog-preview-convert-titles t + org-static-blog-preview-ellipsis "more ..." + org-static-blog-enable-tags t + org-static-blog-tags-file "tags.html" + org-static-blog-rss-file "rss.xml" + org-static-blog-publish-url "https://jao.io/blog/" + org-static-blog-publish-title "programming (and other) musings" + org-static-blog-posts-directory (jao-blog-dir "posts/") + org-static-blog-drafts-directory (jao-blog-dir "pages/") + org-static-blog-publish-directory (jao-blog-dir "blog/") + org-static-blog-rss-extra "" ; "<author>mail@jao.io</author>\n" + org-static-blog-rss-max-entries 30 + org-static-blog-rss-excluded-tag "norss" + org-static-blog-enable-tag-rss t + org-export-with-toc nil + org-export-with-section-numbers nil) + + :config + (defun jao-org-static-post-path (pf dt) + (cond ((string-match-p "pages/.*\\|in-no-particular-order" pf) + (file-name-nondirectory pf)) + ((string-match-p "drafts/.*" pf) pf) + ((string-match-p "^[[:digit:]]+-.*" pf) pf) + (t (concat (format-time-string "%Y-%m-%d-" dt) + (file-name-nondirectory pf))))) + (advice-add 'org-static-blog-generate-post-path :override + #'jao-org-static-post-path) + + :bind (:map org-mode-map (("C-c B" . jao-transient-org-blog)))) + +;;; New entries +(defun jao-org-blog-publish-file (fname) + (interactive (list (read-file-name "Publish: " + nil + (buffer-file-name) + t + (buffer-file-name)))) + (let ((geiser-active-implementations '(guile)) + (geiser-default-implementation 'guile) + (whitespace-style nil)) + (org-static-blog-publish-file fname))) + +(defconst jao-org-static-blog--prev-beg "#+html: <!-- preview-start -->") + +(defconst jao-org-static-blog--prev-end "#+html: <!-- preview-end -->") + +(defun jao-org-static-blog-create-new-post (&optional draft) + (interactive) + (let* ((title (read-string "Title: ")) + (file (replace-regexp-in-string "\s" "-" (downcase title))) + (tags (completing-read-multiple "Tags: " jao-org-blog-tag-names))) + (find-file (expand-file-name (concat file ".org") + (if draft + org-static-blog-drafts-directory + org-static-blog-posts-directory))) + (insert "#+title: " title "\n" + "#+date: " (format-time-string "<%Y-%m-%d %H:%M>") "\n" + "#+filetags: " + (mapconcat #'identity tags " ") + "\n\n") + (when (member "books" tags) + (insert jao-org-static-blog--prev-beg "\n\n[[../img/" file ".jpg]]\n\n")) + (save-excursion (insert jao-org-static-blog--prev-end "\n")))) + +;;; Drafts +(defun jao-org-static-blog-update-date () + (interactive) + (when (y-or-n-p "Update date? ") + (goto-char (point-min)) + (when (re-search-forward "^#\\+date: " nil t) + (delete-line) + (insert (format-time-string "<%Y-%m-%d %H:%M>")) + (save-buffer)))) + +(defun jao-org-static-blog-create-new-draft () + (interactive) + (jao-org-static-blog-create-new-post t)) + +(defun jao-org-static-blog-publish-draft () + (interactive) + (let* ((from (read-file-name "Post: " + org-static-blog-drafts-directory + nil t)) + (to (expand-file-name (file-name-nondirectory from) + org-static-blog-posts-directory))) + (rename-file from to) + (when-let ((b (get-buffer from))) + (kill-buffer b)) + (find-file to) + (jao-org-static-blog-update-date) + (when (y-or-n-p "Generate HTML? ") + (jao-org-blog-publish)))) + +(defun jao-org-static-blog-edit-draft () + (interactive) + (find-file (read-file-name "Edit: " + org-static-blog-drafts-directory + nil + t))) + +;;; Publish +(defun jao-org-blog-publish (&optional force) + (interactive "P") + (let ((geiser-active-implementations '(guile)) + (geiser-default-implementation 'guile) + (whitespace-style nil)) + (org-static-blog-publish force))) + +(defun jao-org-blog-republish () + (interactive) + (jao-org-blog-publish t)) + +;;; Transient +(defun jao-org-static-prev-begin () + (interactive) + (insert jao-org-static-blog--prev-beg)) + +(defun jao-org-static-prev-end () + (interactive) + (insert jao-org-static-blog--prev-end)) + +(transient-define-prefix jao-transient-org-blog () + [["Insert blog snippet" + ("s" "preview begin" jao-org-static-prev-begin) + ("S" "preview end" jao-org-static-prev-end) + ("T" "update date" jao-org-static-blog-update-date)] + ["Edit blog" + ("n" "create post" jao-org-static-blog-create-new-post) + ("d" "create draft" jao-org-static-blog-create-new-draft) + ("e" "edit draft" jao-org-static-blog-edit-draft)] + ["Publish blog" + ("D" "publish draft" jao-org-static-blog-publish-draft) + ("f" "publish single file" jao-org-blog-publish-file) + ("p" "publish all" jao-org-blog-publish) + ("r" "republish" jao-org-blog-republish)]]) + +;;; . +(provide 'jao-custom-blog) diff --git a/custom/jao-custom-completion.el b/custom/jao-custom-completion.el new file mode 100644 index 0000000..490fd65 --- /dev/null +++ b/custom/jao-custom-completion.el @@ -0,0 +1,424 @@ +;; -*- lexical-binding: t; -*- + +;;; builtin completion +(setq tab-always-indent 'complete + read-extended-command-predicate #'command-completion-default-include-p + completion-auto-select 'second-tab + completion-auto-help 'always + completion-category-defaults nil + completion-cycle-threshold 4 + completions-detailed t + completions-header-format nil + completion-ignore-case t + completion-show-help nil + completion-show-inline-help t + completions-format 'one-column + completion-styles '(basic substring partial-completion emacs22) + completion-category-overrides + '((file (styles partial-completion)) + (command (styles initials substring partial-completion)) + (symbol (styles initials substring partial-completion)) + (variable (styles initials substring partial-completion))) + completion-wrap-movement t) + +;;; crm indicator +(defun jao-completion--crm-indicator (args) + "Add prompt indicator to `completing-read-multiple' filter ARGS." + (cons (concat "[CRM] " (car args)) (cdr args))) + +(advice-add #'completing-read-multiple + :filter-args #'jao-completion--crm-indicator) + +;;; orderless +(use-package orderless + :ensure t + :demand t + :config + (orderless-define-completion-style orderless+initialism + (orderless-matching-styles '(orderless-initialism + orderless-prefixes + orderless-literal + orderless-regexp))) + (defvar jao-orderless-overrides + '((file (styles partial-completion orderless)) + (command (styles orderless+initialism)))) + + (setq orderless-matching-styles + '(orderless-literal orderless-regexp orderless-prefixes))) + +;;; marginalia +(use-package marginalia + :ensure t + :bind (:map minibuffer-local-map ("C-M-a" . marginalia-cycle)) + + :custom ((marginalia-align 'left) + (marginalia-align-offset 1) + (marginalia-field-width 200) + (marginalia-annotators + '(marginalia-annotators-heavy marginalia-annotators-light nil)) + (marginalia-separator " "))) + +(marginalia-mode 1) + +;;; vertico +(use-package vertico + :ensure t + :init + (defvar jao-vertico-reverse t) + + (setq vertico-count 20 + vertico-cycle t + vertico-resize t + vertico-multiform-categories nil + vertico-multiform-commands + `((".*" + (completion-styles orderless basic) + (completion-category-overrides . ,jao-orderless-overrides))) + vertico-buffer-display-action + `(display-buffer-below-selected (window-height . 0.5))) + + (dolist (c '(completion-at-point complete-symbol indent-for-tab-command)) + (let ((s `(,c buffer (vertico-resize) (jao-vertico-reverse)))) + (add-to-list 'vertico-multiform-commands s))) + + :config + (defun jao-vertico--display (fun lines) + (if (not jao-vertico-reverse) + (funcall fun lines) + (move-overlay vertico--candidates-ov (point-min) (point-min)) + (overlay-put vertico--candidates-ov 'after-string (apply #'concat lines)) + (vertico--resize))) + + (advice-add 'vertico--display-candidates :around #'jao-vertico--display)) + +(use-package vertico-directory + :after vertico + :bind (:map vertico-map (("RET" . vertico-directory-enter) + ("M-<backspace>" . vertico-directory-delete-word) + ("<backspace>" . vertico-directory-delete-char) + ("DEL" . vertico-directory-delete-char)))) + +(vertico-mode) +(vertico-multiform-mode) + +;;; consult +;;;; package +(use-package consult + :ensure t + :bind (("C-x M-:" . consult-complex-command) + ("C-x b" . consult-buffer) + ("C-x C-b" . switch-to-buffer) + ("C-x 4 b" . consult-buffer-other-window) + ("C-c b" . project-find-file) + ("C-c h" . nil) + ("C-c i" . consult-imenu) + ("C-c I" . consult-project-imenu) + ("C-h I" . consult-info) + ;; ("C-c o" . consult-outline) + ("C-c k" . consult-ripgrep) + ("C-c L" . consult-locate) + ("C-c s" . consult-line) + ("C-x r x" . consult-register) + ("C-x r b" . consult-bookmark) + ("C-x C-f" . jao-find-file) + ("M-g b" . consult-bookmark) + ("M-g m" . consult-mark) + ("M-g e" . consult-error) + ("M-s m" . consult-multi-occur) + ("M-y" . consult-yank-pop) + ("C-s" . isearch-forward)) + + :custom ((consult-preview-key (kbd "`"))) + + :init + (fset 'multi-occur #'consult-multi-occur) + (setq org-refile-use-outline-path t + org-imenu-depth 7) + + :config + (defun jao-consult--completion-in-region (&rest args) + (apply (if (and (not (bound-and-true-p corfu-mode)) + (not (bound-and-true-p company-mode)) + (bound-and-true-p vertico-mode)) + #'consult-completion-in-region + #'completion--in-region) + args)) + + (setq completion-in-region-function #'jao-consult--completion-in-region) + + (defun jao-find-file (arg) + (interactive "P") + (call-interactively (if arg 'consult-file-externally 'find-file))) + + (define-key consult-narrow-map (vconcat consult-narrow-key "?") + #'consult-narrow-help) + + (with-eval-after-load "esh-mode" + (define-key eshell-mode-map (kbd "C-c h") #'consult-history)) + + (with-eval-after-load "comint" + (define-key comint-mode-map (kbd "C-c h") #'consult-history)) + + (consult-customize consult-mark :preview-key 'any) + (add-hook 'completion-list-mode-hook #'consult-preview-at-point-mode)) + +;;;; consult-dir +;; (use-package consult-dir +;; :ensure t +;; :bind (("C-x C-d" . consult-dir) +;; :map minibuffer-local-completion-map +;; (("C-x C-d" . consult-dir) +;; ("C-x C-j" . consult-dir-jump-file)))) + +;;;; narrow helpers +(defvar jao-consult-narrow nil) + +(defun jao-consult-initial-narrow () + (when-let (c (cond ((eq this-command #'consult-buffer) + (cdr (assoc (jao-afio-frame-name) jao-consult-narrow))) + ((eq this-command #'consult-mode-command) ?m))) + (setq unread-command-events (append unread-command-events `(,c 32))))) + +(add-hook 'minibuffer-setup-hook #'jao-consult-initial-narrow) + +(defmacro jao-consult--mode-buffers (&rest modes) + `(lambda () + (seq-map #'buffer-name + (seq-filter (lambda (b) + (with-current-buffer b + (derived-mode-p ,@modes))) + (buffer-list))))) + +(defun jao-consult-add-buffer-source (src &optional aframe key) + (add-to-list 'consult-buffer-sources src t) + (when (and aframe key) + (add-to-list 'jao-consult-narrow (cons aframe key)))) + +;;; embark +;;;; package +(use-package embark + :ensure t + :demand t + :init + (setq embark-quit-after-action nil + embark-indicators '(embark-mixed-indicator + ;; embark-minimal-indicator + embark-highlight-indicator + embark-isearch-highlight-indicator) + embark-mixed-indicator-both t + embark-mixed-indicator-delay 1 + embark-verbose-indicator-buffer-sections '(bindings) + embark-verbose-indicator-excluded-commands + '(embark-become embark-export embark-collect) + embark-verbose-indicator-nested t + embark-verbose-indicator-display-action + '((display-buffer-at-bottom) + (window-parameters (mode-line-format . none)) + (window-height . fit-window-to-buffer))) + + ;; (setq prefix-help-command #'describe-prefix-bindings) + ;; (add-to-list 'vertico-multiform-categories '(embark-keybinding grid)) + + :bind (("C-;" . embark-act) + ("C-c ;" . embark-act) + ("C-'" . embark-dwim) + ("C-c '" . embark-dwim) + (:map minibuffer-local-map + (("C-'" . embark-dwim) + ("C-c '" . embark-dwim) + ("C-," . embark-become) + ("C-c ," . embark-become) + ("C-o" . embark-export))))) + +(use-package embark-consult + :ensure t + :after (embark consult)) + +(with-eval-after-load 'consult + (with-eval-after-load 'embark + (require 'embark-consult))) + +;;;; randomsig +(defun jao-random-sig-read (_ignored) + "Import region as signature and edit it." + (randomsig-message-read-sig t)) + +(define-key embark-region-map "m" #'jao-random-sig-read) +(define-key embark-region-map "M" #'apply-macro-to-region-lines) + +;;;; dict/say +(defun jao-say (&optional word) + "Isn't it nice to have a computer that can talk to you?" + (interactive "sWhat? ") + (shell-command-to-string (format "say %s" word)) + "") + +(define-key embark-identifier-map "D" #'dictionary-search) +(define-key embark-identifier-map "S" #'jao-say) + +;;;; org targets +(declare-function org-link-any-re "ol") +(declare-function org-open-link-from-string "ol") +(declare-function org-in-regexp "org-macs") + +(defun jao-embark-targets--org-link () + (when (derived-mode-p 'org-mode) + (let ((lnk (org-element-property :raw-link (org-element-context)))) + (and lnk (cons 'org-link lnk))))) + +(defun jao-embark-targets--gl-org-link () + (when (org-in-regexp org-link-bracket-re) + (cons 'gl-org-link (match-string-no-properties 0)))) + +(defvar jao-embark-targets-gl-org-link-map + (define-keymap "RET" #'org-open-at-point-global)) + +(defvar jao-embark-targets-org-link-map + (define-keymap "RET" #'org-open-link-from-string)) + +(add-to-list 'embark-target-finders #'jao-embark-targets--gl-org-link) +(add-to-list 'embark-keymap-alist + '(gl-org-link . jao-embark-targets-gl-org-link-map)) + +(add-to-list 'embark-target-finders #'jao-embark-targets--org-link) +(add-to-list 'embark-keymap-alist + '(org-link . jao-embark-targets-org-link-map)) + +;;;; url targets +(declare-function w3m-anchor "w3m") + +(defun jao-embark-targets--w3m-anchor () + (when (not (region-active-p)) + (when-let ((url (or (jao-url-around-point) + (thing-at-point 'url) + (and (derived-mode-p 'w3m-mode) + (or (w3m-anchor) w3m-current-url)) + (and (derived-mode-p 'eww-mode) + (eww-current-url))))) + (when (string-match-p "^https?.*" url) + (cons 'url url))))) + +(add-to-list 'embark-target-finders #'jao-embark-targets--w3m-anchor) + +(defun jao-embark-url (url) + "Browse URL, externally if we're already in an emacs browser." + (if (derived-mode-p 'w3m-mode 'eww-mode) + (jao-browse-with-external-browser url) + (browse-url url))) + +(define-key embark-url-map (kbd "RET") #'jao-embark-url) +(define-key embark-url-map (kbd "f") #'browse-url-firefox) +(define-key embark-url-map (kbd "x") #'jao-rss-subscribe) +(define-key embark-url-map (kbd "m") 'jao-browse-with-external-browser) +(define-key embark-url-map (kbd "p") 'jao-mpc-add-or-play-url) + +;;;; video url targets +(defvar jao-embark-targets-video-sites + '("youtu.be" "youtube.com" "blip.tv" "vimeo.com" "infoq.com")) + +(defun jao-embark--video-url-rx (&optional sites) + (format "^https?://\\(?:www\\.\\)?%s/.+" + (regexp-opt (or sites jao-embark-targets-video-sites) t))) + +(defvar jao-embark-targets-video-url-rx (jao-embark--video-url-rx) + "A regular expression matching URLs that point to video streams") + +(defun jao-embark-targets--refine-url (_ url) + (if (string-match-p jao-embark-targets-video-url-rx url) + (cons 'video-url url) + (cons 'url url))) + +(defun jao-embark-targets--play-video (player url) + (interactive "sURL: ") + (let ((cmd (format "%s %s" player (shell-quote-argument url)))) + (jao-afio-goto-www) + (start-process-shell-command player nil cmd))) + +(defun jao-embark-targets-mpv (&optional url) + "Play video stream with mpv" + (interactive "sURL: ") + (jao-embark-targets--play-video "mpv" url)) + +(defun jao-embark-targets-vlc (&optional url) + "Play video stream with vlc" + (interactive "sURL: ") + (jao-embark-targets--play-video "vlc" url)) + +(defvar jao-embark-targets-video-url-map + (define-keymap "v" #'jao-embark-targets-mpv "RET" #'jao-embark-targets-mpv) + "Actions on URLs pointing to remote video streams.") + +(add-to-list 'embark-transformer-alist '(url . jao-embark-targets--refine-url)) +(add-to-list 'embark-keymap-alist '(video-url . jao-embark-targets-video-url-map)) +(define-key embark-url-map "v" #'jao-embark-targets-vlc) +(define-key embark-url-map "V" #'jao-embark-targets-vlc) + +;;;; vc targets + + +;;; avy +(use-package avy + :ensure t + :init (setq avy-style 'pre + avy-background t + avy-timeout-seconds 0.6 + avy-single-candidate-jump t) + + :config + + (defun avy-embark-act (pt) + "Use Embark to act on the completion at PT." + (save-excursion + (goto-char pt) + (embark-act))) + (add-to-list 'avy-dispatch-alist '(?\; . avy-embark-act)) + + :bind (("s-j" . avy-goto-char-timer) + ("C-M-j" . avy-goto-char-timer))) + +;;; link-hint +(use-package link-hint + :ensure t + :init (setq link-hint-avy-style 'pre + link-hint-message nil) + + :config + (defun jao-link-hint-open-link-ext () + (interactive) + (let ((jao-browse-url-function jao-browse-url-external-function)) + (link-hint-open-link))) + + :bind (("C-l" . link-hint-open-link) + ("C-M-l" . jao-link-hint-open-link-ext) + ("C-S-l" . jao-link-hint-open-link-ext) + ("C-x C-l" . recenter-top-bottom))) + +(with-eval-after-load "notmuch" + (defun jao-link-hint--notmuch-next-part (&optional bound) + (when-let (p (next-single-property-change (point) :notmuch-part nil bound)) + (and (< p (or bound (point-max))) p))) + + (defun jao-link-hint--notmuch-part-p () + (and (get-text-property (point) :notmuch-part) + (when-let (b (button-at (point))) (button-label b)))) + + (link-hint-define-type 'notmuch-part + :next #'jao-link-hint--notmuch-next-part + :at-point-p #'jao-link-hint--notmuch-part-p + :vars '(notmuch-show-mode) + :open #'push-button + :open-message "Toggled" + :open-multiple t) + + (push 'link-hint-notmuch-part link-hint-types)) + +;;; xref +(setq xref-show-definitions-function #'xref-show-definitions-completing-read) + +;; (use-package dumb-jump +;; :ensure t +;; :after xref +;; :config (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) + +;;; . +(provide 'jao-custom-completion) diff --git a/custom/jao-custom-email.el b/custom/jao-custom-email.el new file mode 100644 index 0000000..a3d1a92 --- /dev/null +++ b/custom/jao-custom-email.el @@ -0,0 +1,318 @@ +;; -*- lexical-binding: t; -*- + +;;; main email system +(require 'jao-afio) +(setq jao-afio-mail-function 'gnus) +;; (setq jao-afio-mail-function 'notmuch) + +(defvar jao-notmuch-enabled (eq jao-afio-mail-function 'notmuch)) + +;;; personal emails and others +(defvar jao-mails) +(defvar jao-extra-mails) +(defvar jao-mails-regexp (regexp-opt jao-mails)) + +;;; gnus +(setq gnus-init-file "~/.emacs.d/gnus.el" + gnus-home-directory "~/.emacs.d/gnus" + gnus-directory gnus-home-directory + gnus-cache-directory (expand-file-name "cache" gnus-home-directory) + gnus-kill-files-directory (expand-file-name "News" gnus-home-directory) + message-directory (expand-file-name "Mail" gnus-home-directory) + mail-source-directory (expand-file-name "Mail" gnus-home-directory)) +;;; proton +(use-package jao-proton-utils) + +;;; message mode +;;;; customization +(setq message-send-mail-function 'message-send-mail-with-sendmail + message-sendmail-envelope-from 'header + message-sendmail-f-is-evil nil) +(setq imap-store-password t) +(setq password-cache-expiry nil) +(setq message-generate-headers-first t) +(setq message-forward-before-signature nil) +(setq message-alternative-emails + (regexp-opt (append jao-mails jao-extra-mails))) +(setq message-dont-reply-to-names + (regexp-opt (append jao-mails '("noreply@" "@noreply" + "no-reply@" "@no-reply" + "notifications@github")))) +(setq message-citation-line-format "On %a, %b %d %Y, %N wrote:\n") +(setq message-citation-line-function 'message-insert-formatted-citation-line) + +(setq message-user-fqdn "mail.jao.io") + +(setq message-kill-buffer-on-exit t) +(setq message-max-buffers 5) +(setq message-insert-signature t) +(setq message-from-style 'angles + user-mail-address (car jao-mails) + mail-host-address system-name + message-syntax-checks '((sender . disabled)) + message-default-headers + (concat + "X-Attribution: jao\n" + "X-Clacks-Overhead: GNU Terry Pratchett\n" + "X-URL: <https://jao.io/>\n") + message-hidden-headers + '("^References:" "^Face:" "^X-Face:" "^X-Draft-From:") + message-make-forward-subject-function 'message-forward-subject-fwd) + +(setq message-expand-name-standard-ui t) + +;;;; adjust bcc +(defvar jao-message--bcc-alist + `((,(regexp-quote "mail@jao.io") . "proton@jao.io") + (,(regexp-quote "jao@gnu.org") . "hacking@jao.io"))) + +(defun jao-message-insert-bcc () + (when jao-notmuch-enabled + (let ((f (or (message-fetch-field "From") ""))) + (when-let (b (seq-some (lambda (x) (when (string-match-p (car x) f) (cdr x))) + jao-message--bcc-alist)) + (insert "Bcc: " b "\n"))))) + +;; (when jao-notmuch-enabled +;; (add-hook 'message-header-setup-hook #'jao-message-insert-bcc)) + +;;;; to->from +(defvar jao-message-to-from nil) + +(defun jao-message-adjust-from () + (let ((to (concat (message-fetch-field "To") (message-fetch-field "Cc")))) + (when-let* ((tf (seq-find (lambda (tf) (string-match-p (car tf) to)) + jao-message-to-from)) + (from (message-make-from "Jose A Ortega Ruiz" (cdr tf)))) + (save-restriction + (widen) + (message-replace-header "From" from))))) + +(when jao-notmuch-enabled + (add-hook 'message-header-setup-hook #'jao-message-adjust-from)) + +;;;; encryption +(setq gnutls-min-prime-bits nil) +(setq gnus-buttonized-mime-types + '("multipart/encrypted" "multipart/signed" "multipart/alternative")) + +(setq mm-verify-option 'always) +(setq mm-decrypt-option 'always) + +(setq mm-sign-option 'guided) +(setq mm-encrypt-option 'guided) + +(setq mml-secure-passphrase-cache-expiry (* 3600 24) + password-cache-expiry (* 3600 24)) + +(setq smime-CA-directory "/etc/ssl/certs/" + smime-certificate-directory + (expand-file-name "certs/" gnus-directory)) + +(with-eval-after-load "mm-decode" + ;; Tells Gnus to inline the part + (add-to-list 'mm-inlined-types "application/pgp$") + ;; Tells Gnus how to display the part when it is requested + (add-to-list 'mm-inline-media-tests '("application/pgp$" + mm-inline-text identity)) + ;; Tell Gnus not to wait for a request, just display the thing + ;; straight away. + (add-to-list 'mm-automatic-display "application/pgp$") + ;; But don't display the signatures, please. + (setq mm-automatic-display (remove "application/pgp-signature" + mm-automatic-display))) + +;; decide whether to encrypt or just sign outgoing messages +(defvar jao-message-try-sign nil) +(defun jao-message-maybe-sign () + (when (and jao-message-try-sign (y-or-n-p "Sign message? ")) + (if (y-or-n-p "Encrypt message? ") + (let ((recipient (message-fetch-field "To"))) + (if (or (pgg-lookup-key recipient) + (and (y-or-n-p (format "Fetch %s's key? " recipient)) + (pgg-fetch-key pgg-default-keyserver-address + recipient))) + (mml-secure-message-encrypt-pgp) + (mml-secure-message-sign-pgp))) + (mml-secure-message-sign-pgp)))) + +;; for ma gnus +(eval-after-load "rfc2047" + '(add-to-list 'rfc2047-header-encoding-alist + '("User-Agent" . address-mime))) + +;;;; check attachment +(defvar jao-message-attachment-regexp "\\([Ww]e send\\|[Ii] send\\|attach\\)") +(defun jao-message-check-attachment () + "Check if there is an attachment in the message if I claim it." + (save-excursion + (message-goto-body) + (when (search-forward-regexp jao-message-attachment-regexp nil t nil) + (message-goto-body) + (unless (or (search-forward "<#part" nil t nil) + (message-y-or-n-p + "No attachment. Send the message? " nil nil)) + (error "No message sent"))))) + +;;;; check fcc/gcc +(defun jao-message-check-gcc () + "Ask whether to keep a copy of message." + (save-excursion + (save-restriction + (message-narrow-to-headers) + (when (and (or (message-fetch-field "Gcc") + (message-fetch-field "Fcc")) + (not (y-or-n-p "Archive? "))) + (message-remove-header "\\(?:[BFG]cc\\)"))))) + +;;;; check recipient +(defun jao-message-check-recipient () + (save-excursion + (save-restriction + (message-narrow-to-headers) + (when-let ((to (message-fetch-field "To"))) + (when (string-match-p jao-mails-regexp to) + (unless (y-or-n-p "Message is addressed to yourself. Continue?") + (error "Message not sent"))))))) + +;;;; randomsig +(with-eval-after-load "message" + (when (require 'randomsig nil t) + (define-key message-mode-map (kbd "C-c s") 'randomsig-replace-sig) + (define-key message-mode-map (kbd "C-c S") 'randomsig-select-sig) + (setq randomsig-dir (expand-file-name "~/etc/config/emacs")) + (setq randomsig-files '("signatures.txt")) + ;; or (setq randomsig-files (randomsig-search-sigfiles)) + ;; or (setq randomsig-files 'randomsig-search-sigfiles) + (setq message-signature 'randomsig-signature) + (setq randomsig-delimiter-pattern "^%$" + randomsig-delimiter "%"))) + +;;;; send mail hooks +(dolist (h '(jao-message-check-gcc + jao-message-check-recipient + jao-message-maybe-sign)) + (add-hook 'message-send-hook h)) + +(unless jao-notmuch-enabled + (add-hook 'message-send-hook #'jao-message-check-attachment)) + +;;;; keybindings +(with-eval-after-load "message" + ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp) + (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp) + (define-key message-mode-map (kbd "C-c y") #'yank-media)) + +;;; sendmail/smtp +(defun jao-sendmail-gmail () + (setq smtpmail-auth-supported '(login cram-md5 plain)) + (setq smtpmail-smtp-server "smtp.gmail.com") + (setq smtpmail-smtp-service 587)) + +(defun jao-sendmail-local () + (setq send-mail-function 'sendmail-send-it) + (setq smtpmail-auth-supported nil) ;; (cram-md5 plain login) + (setq smtpmail-servers-requiring-authorization nil) + (setq smtpmail-smtp-user nil) + (setq smtpmail-smtp-server "127.0.0.1") + (setq smtpmail-smtp-service 25)) + +(defun jao-sendmail-msmtp () + (setq send-mail-function 'sendmail-send-it + sendmail-program "/usr/bin/msmtp" + mail-specify-envelope-from t + message-sendmail-envelope-from 'header + mail-envelope-from 'header)) + +(jao-sendmail-local) + +;;; bbdb +;; (jao-load-path "bbdb/lisp") +(use-package bbdb + :ensure t + :init (setq bbdb-complete-name-allow-cycling t + bbdb-completion-display-record nil + bbdb-gui t + bbdb-message-all-addresses t + bbdb-complete-mail-allow-cycling t + bbdb-north-american-phone-numbers-p nil + bbdb-add-aka t + bbdb-add-name 2 + bbdb-message-all-addresses t + bbdb-mua-pop-up t ;; 'horiz + bbdb-mua-pop-up-window-size 0.3 + bbdb-layout 'multi-line + bbdb-mua-update-interactive-p '(query . create) + bbdb-mua-auto-update-p 'bbdb-select-message + bbdb-user-mail-address-re jao-mails-regexp + bbdb-auto-notes-ignore-headers + `(("From" . ,jao-mails-regexp) + ("From" . ".*@.*github\.com.*") + ("To" . ".*@.*github\.com.*") + ("Reply-to" . ".*") + ("References" . ".*")) + bbdb-auto-notes-ignore-messages + `(("To" . ".*@.*github\\.com.*") + ("From" . ".*@.*github\\.com.*") + ("From" . "info-list") + ("From" . "no-?reply\\|deploy") + ("X-Mailer" . "MailChimp")) + bbdb-accept-message-alist + `(("To" . ,jao-mails-regexp) + ("Cc" . ,jao-mails-regexp) + ("BCc" . ,jao-mails-regexp)) + bbdb-ignore-message-alist bbdb-auto-notes-ignore-messages) + :config + (add-hook 'message-setup-hook 'bbdb-mail-aliases) + ;; (add-hook 'bbdb-notice-mail-hook 'bbdb-auto-notes) + (add-hook 'bbdb-after-change-hook (lambda (arg) (bbdb-save))) + (require 'bbdb-anniv) ;; BBDB 3.x this gets birthdays in org agenda and diary + (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries) + + (setq bbdb-file (expand-file-name "~/.emacs.d/bbdb")) + (if jao-notmuch-enabled + (bbdb-initialize 'message 'notmuch) + (bbdb-initialize 'message 'pgp 'gnus))) + +;; (load "bbdb-loaddefs") + +;;; narrowing +(defvar jao-mail-consult-buffer-history nil) + +(defun jao-mail-buffer-p (b) + (or (member (buffer-name b) + '("*Calendar*" "inbox.org" "*Org Agenda*" + "*Fancy Diary Entries*" "diary")) + (with-current-buffer b + (derived-mode-p 'notmuch-show-mode + 'notmuch-search-mode + 'notmuch-tree-mode + 'notmuch-hello-mode + 'notmuch-message-mode + 'gnus-group-mode + 'gnus-summary-mode + 'gnus-article-mode + 'message-mode)))) + +(defvar jao-mail-consult-source + (list :name "mail buffer" + :category 'buffer + :hidden t + :narrow (cons ?n "mail buffer") + :history 'jao-mail-consult-buffer-history + :action (lambda (b) + (when (not (string-blank-p (or b ""))) + (jao-afio-goto-mail) + (if (get-buffer-window b) + (pop-to-buffer b) + (pop-to-buffer-same-window b)))) + :items (lambda () + (mapcar #'buffer-name + (seq-filter #'jao-mail-buffer-p (buffer-list)))))) + +(jao-consult-add-buffer-source 'jao-mail-consult-source) + +(require 'jao-custom-notmuch) + +;;; . +(provide 'jao-custom-email) diff --git a/custom/jao-custom-eww.el b/custom/jao-custom-eww.el new file mode 100644 index 0000000..1b766c9 --- /dev/null +++ b/custom/jao-custom-eww.el @@ -0,0 +1,286 @@ +;; -*- lexical-binding: t -*- + +;;; integration with browse-url and afio +(defun jao-eww-browse-url (url &rest _r) + "Browse URL using eww." + (if (derived-mode-p 'eww-mode) + (eww url) + (jao-afio-goto-www) + (select-window (frame-first-window)) + (let* ((url (url-encode-url url)) + (bf (seq-find `(lambda (b) + (with-current-buffer b + (string= ,url + (url-encode-url (eww-current-url))))) + (jao-eww-session-eww-buffers)))) + (cond (bf (switch-to-buffer bf)) + ((string-match-p url "^file://") (eww-open-file url)) + (t (eww url 4)))))) + +(setq jao-browse-url-function #'jao-eww-browse-url) +(setq eww-use-browse-url "^\\(gemini\\|gopher\\):") + +;;; multipart html renderer +(defun jao-shr-html-renderer (handle) + (let ((fill-column nil) + (shr-width 150) + (shr-max-width 150)) + (mm-shr handle))) + +(setq mm-text-html-renderer #'jao-shr-html-renderer) + +;;; opening URLs +(defun jao-eww-copy-link () + (interactive) + (when-let (lnk (or (car (eww-links-at-point)) (eww-current-url))) + (message "%s" lnk) + (kill-new lnk))) + +(defun jao-eww-browse (arg) + (interactive "P" eww-mode) + (setq eww-prompt-history + (cl-remove-duplicates eww-prompt-history :test #'string=)) + (let ((url (completing-read (if arg "eww in new buffer: " "eww: ") + eww-prompt-history nil nil nil + 'eww-prompt-history (eww-current-url)))) + (eww url (when arg 4)))) + +(defun jao-eww-browse-new () + (interactive nil eww-mode) + (jao-eww-browse t)) + +(defun jao-eww-reload (images) + (interactive "P" eww-mode) + (if images + (let ((shr-blocked-images nil)) + (eww-reload t)) + (call-interactively 'eww-reload))) + +;;; consult narrowing +(with-eval-after-load "consult" + (defvar jao-eww-consult-history nil) + (defvar jao-eww-buffer-source + (list :name "eww buffer" + :category 'eww-buffer + :hidden t + :narrow (cons ?e "eww") + :annotate (lambda (c) (get-text-property 0 'url c)) + :history 'jao-eww-consult-history + :action (lambda (b) + (jao-afio-goto-www) + (switch-to-buffer (get-text-property 0 'buffer b))) + :items + (lambda () + (seq-map (lambda (b) + (with-current-buffer b + (let ((tl (or (plist-get eww-data :title) "")) + (url (or (eww-current-url) (buffer-name)))) + (propertize (if (string-blank-p tl) url tl) + 'buffer b 'url url)))) + (seq-filter #'jao-www--buffer-p (buffer-list)))))) + (jao-consult-add-buffer-source 'jao-eww-buffer-source)) + +;;; images +(defun jao-eww-next-image () + (interactive nil eww-mode) + (when-let (p (text-property-search-forward 'image-displayer nil nil t)) + (goto-char (prop-match-beginning p)))) + +;;; close page and reopen +(defvar jao-eww--closed-urls ()) + +(defun jao-eww-close () + (interactive nil eww-mode) + (when-let (current (eww-current-url)) + (add-to-list 'jao-eww--closed-urls current)) + (let ((nxt (car (jao-eww-session-invisible-buffers)))) + (kill-current-buffer) + (when nxt (switch-to-buffer nxt nil t)))) + +(defun jao-eww-reopen (arg) + (interactive "P") + (if (> (length jao-eww--closed-urls) 0) + (let ((url (completing-read "URL: " jao-eww--closed-urls))) + (jao-afio-goto-www) + (setq jao-eww--closed-urls (remove url jao-eww--closed-urls)) + (eww url (when arg 4))) + (message "No previously closed URLs."))) + +(defun jao-eww-reopen-new () + (interactive) + (jao-eww-reopen t)) + +;;; sessions +(use-package jao-eww-session + :custom ((jao-eww-session-file "~/.emacs.d/cache/eww-session.eld"))) + +;;; eww to org +(defun jao-eww-to-org (&optional dest) + (interactive "P") + (unless (or (and (interactive-p) dest) (org-region-active-p)) + (let ((shr-width 80)) (eww-readable))) + (let* ((dest (unless (interactive-p) dest)) + (start (if (org-region-active-p) (region-beginning) (point-min))) + (end (if (org-region-active-p) (region-end) (point-max))) + (link (eww-current-url)) + (title (plist-get eww-data :title)) + (buff (save-current-buffer (or dest (jao-org-notes-create title))))) + (with-current-buffer buff + (insert "#+link: " link "\n\n") + (org-mode)) + (save-excursion + (goto-char start) + (while (< (point) end) + (let* ((p (point)) + (props (text-properties-at p)) + (k (seq-find (lambda (x) (plist-get props x)) + '(shr-url image-url outline-level face))) + (prop (and k (list k (plist-get props k)))) + (next (if prop + (next-single-property-change p (car prop) nil end) + (next-property-change p nil end))) + (txt (buffer-substring (point) next)) + (txt (replace-regexp-in-string "\\*" "·" txt))) + (with-current-buffer buff + (insert + (pcase prop + ((and (or `(shr-url ,url) `(image-url ,url)) + (guard (string-match-p "^http" url))) + (let ((tt (replace-regexp-in-string "\n\\([^$]\\)" " \\1" txt))) + (org-link-make-string url tt))) + (`(outline-level ,n) + (concat (make-string (- (* 2 n) 1) ?*) " " txt "\n")) + ('(face italic) (format "/%s/ " (string-trim txt))) + ('(face bold) (format "*%s* " (string-trim txt))) + (_ txt)))) + (goto-char next)))) + (pop-to-buffer buff) + (goto-char (point-min)))) + +;;; rdrview +;; https://jiewawa.me/2024/04/another-way-of-integrating-mozilla-readability-in-emacs-eww/ +(define-minor-mode eww-rdrview-mode + "Toggle whether to use `rdrview' to make eww buffers more readable." + :lighter " R" + (if eww-rdrview-mode + (progn + (setq eww-retrieve-command '("rdrview" "-T" "title,sitename,body" "-H")) + (add-hook 'eww-after-render-hook #'eww-rdrview-update-title)) + (progn + (setq eww-retrieve-command nil) + (remove-hook 'eww-after-render-hook #'eww-rdrview-update-title)))) + +(defun eww-rdrview-update-title () + "Change title key in `eww-data' with first line of buffer. +It should be the title of the web page as returned by `rdrview'" + (save-excursion + (goto-char (point-min)) + (plist-put eww-data :title (string-trim (thing-at-point 'line t)))) + (eww--after-page-change)) + +(defun eww-rdrview-toggle-and-reload () + "Toggle `eww-rdrview-mode' and reload page in current eww buffer." + (interactive) + (if eww-rdrview-mode (eww-rdrview-mode -1) + (eww-rdrview-mode 1)) + (eww-reload)) +;;; auto-readable +(defvar jao-eww-auto-readable-urls + (regexp-opt '("guardian.co.uk" "theguardian.com" "github.com" "eldiario.es"))) + +(defun jao-eww-autoread () + (when (string-match-p jao-eww-auto-readable-urls (or (eww-current-url))) + (eww-readable))) + +(add-hook 'eww-after-render-hook #'jao-eww-autoread) +;;; package +(use-package shr + :custom ((shr-width nil) + (shr-use-colors t) + (shr-use-fonts nil) + (shr-max-width 160) + (shr-blocked-images nil) + (shr-inhibit-images t) + (shr-max-image-proportion 0.8) + (shr-hr-line ?―))) + +(use-package eww + :demand t + :custom ((eww-browse-url-new-window-is-tab nil) + (eww-download-directory jao-sink-dir) + (eww-header-line-format " %u") + (eww-form-checkbox-selected-symbol "☒") + (eww-buffer-name-length 180) + ;; (eww-readable-urls '("guardian\\.co\\.uk" + ;; "theguardian\\.com" + ;; "eldiario\\.es" + ;; "theconversation")) + ) + + :config + (with-eval-after-load "org" (require 'ol-eww nil t)) + + (defun jao-eww-buffer-name () + (when-let ((s (or (plist-get eww-data :title) + (plist-get eww-data :url)))) + (when (not (string-blank-p s)) (format "%s" s)))) + (setq eww-auto-rename-buffer #'jao-eww-buffer-name) + + (defun jao-eww-readable (rdrview) + (interactive "P" eww-mode) + (if rdrview + (eww-rdrview-toggle-and-reload) + (eww-readable))) + + :bind (:map eww-mode-map (("b" . eww-back-url) + ("B" . eww-forward-url) + ("d" . jao-download) + ("f" . link-hint-open-link) + ("F" . embark-on-link) + ("L" . eww-forward-url) + ("N" . jao-eww-next-image) + ("o" . jao-eww-browse) + ("O" . jao-eww-browse-new) + ("r" . jao-eww-reload) + ("R" . jao-eww-readable) + ("s" . eww-search-words) + ("S" . jao-eww-browse-new) + ("T" . jao-mastodon-toot-url) + ("u" . jao-eww-reopen) + ("U" . jao-eww-reopen-new) + ("w" . jao-eww-to-org) + ("q" . jao-eww-close) + ("x" . jao-rss-subscribe) + ("y" . jao-eww-copy-link) + ("\\" . eww-view-source) + ("C-c C-w" . jao-eww-close) + ("M-i" . eww-toggle-images)))) + +;;; fixes for shr image rendering +(require 'shr) + +(defun jao-shr--kill-nl (p) + (save-excursion + (goto-char p) + (when (looking-at-p "\n") (delete-char 1)))) + +(defun jao-shr-tag-img (fn &rest args) + (let ((p (point))) + (prog1 (apply fn args) + (when (> (point) p) (jao-shr--kill-nl p))))) + +(defun jao-shr-insert (fn &rest args) + (let ((p (when (and (not (bolp)) + (get-text-property (1- (point)) 'image-url)) + (point)))) + (prog1 (apply fn args) + (when (and p (> (point) p)) (jao-shr--kill-nl p))))) + +(advice-add 'shr-tag-img :around #'jao-shr-tag-img) +(advice-add 'shr-insert :around #'jao-shr-insert) + +;; (advice-remove 'shr-tag-img #'jao-shr-tag-img) +;; (advice-remove 'shr-insert #'jao-shr-insert) + +;;; . +(provide 'jao-custom-eww) diff --git a/custom/jao-custom-exwm.el b/custom/jao-custom-exwm.el new file mode 100644 index 0000000..3cb3fc9 --- /dev/null +++ b/custom/jao-custom-exwm.el @@ -0,0 +1,538 @@ +;; -*- lexical-binding: t; -*- + +(require 'jao-pdf) + +;;; Load and basic config +(defvar jao-exwm--use-afio t) + +;; (jao-load-path "exwm") + +(use-package exwm + :ensure t + :demand t + :init (setq exwm-debug nil + exwm-workspace-number 1 + exwm-workspace-show-all-buffers t + exwm-workspace-warp-cursor nil + exwm-layout-show-all-buffers t + exwm-floating-border-color + (if (jao-colors-scheme-dark-p) "black" "grey90") + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=58245 : + x-no-window-manager t)) + +(use-package exwm-edit :ensure t) + +;;; Frame(s) as workspaces +(defun jao-exwm--new-frame-p () + (not (frame-parameter nil 'jao-frames-initialized))) + +(defun jao-exwm--mark-frame (force) + (prog1 (or force (jao-exwm--new-frame-p)) + (set-frame-parameter nil 'jao-frames-initialized t))) + +(defun jao-exwm--goto-main (&optional init) + (interactive "P") + (exwm-workspace-switch-create 1) + (when (jao-exwm--mark-frame init) (jao-trisect))) + +(defun jao-exwm--goto-mail (&optional init) + (interactive "P") + (exwm-workspace-switch-create 2) + (when (jao-exwm--mark-frame init) + (jao-afio-open-gnus))) + +(defun jao-exwm--goto-www (&optional init) + (interactive "P") + (exwm-workspace-switch-create 5) + (when (jao-exwm--mark-frame init) + (jao-afio-open-www) + (let ((scroll-bar-mode 'left)) + (toggle-scroll-bar 1) + (set-frame-parameter (window-frame) 'scroll-bar-width 12)) + (jao-toggle-inactive-mode-line))) + +(defun jao-exwm--goto-docs (&optional init) + (interactive "P") + (exwm-workspace-switch-create 4) + (when (jao-exwm--mark-frame init) + (jao-afio-open-doc))) + +(defun jao-exwm-open-doc (file) + (jao-exwm--goto-docs) + (jao-find-or-open file)) + +(defun jao-exwm-no-afio-setup () + (interactive) + (defalias 'jao-open-gnus-frame 'jao-exwm--goto-mail) + (defalias 'jao-goto-www-frame 'jao-exwm--goto-www) + (setq jao-open-doc-fun #'jao-exwm-open-doc) + (setq minibuffer-follows-selected-frame t) + (global-set-key "\C-cf" 'jao-exwm--goto-main) + (global-set-key "\C-cg" 'jao-exwm--goto-mail) + (global-set-key "\C-cw" 'jao-exwm--goto-www) + (global-set-key "\C-cz" 'jao-exwm--goto-docs)) + +(if jao-exwm--use-afio + (setq minibuffer-follows-selected-frame nil) + (jao-exwm-no-afio-setup)) + +;; tracking +(add-hook 'exwm-workspace-switch-hook 'tracking-remove-visible-buffers) + +;;; Buffer names +(defun jao-exwm--use-title-p () + (and exwm-title (not (string-blank-p exwm-title)))) + +(defun jao-exwm-rename-buffer/class () + (unless (jao-exwm--use-title-p) + (exwm-workspace-rename-buffer exwm-class-name))) + +(defun jao-exwm-rename-buffer/title () + (cond ((or (not exwm-instance-name) + (jao-exwm--use-title-p)) + (exwm-workspace-rename-buffer exwm-title)) + ((string= "Zathura" exwm-class-name) + (exwm-workspace-rename-buffer + (format "zathura: %s" (file-name-nondirectory exwm-title)))))) + +(defun jao-exwm--set-exwm-name () + (when (not jao-exwm--name) + (setq jao-exwm--name jao-exwm--current-name + jao-exwm--current-name nil))) + +(add-hook 'exwm-mode-hook 'jao-exwm--set-exwm-name) +(add-hook 'exwm-update-class-hook 'jao-exwm-rename-buffer/class) +(add-hook 'exwm-update-title-hook 'jao-minibuffer-refresh) +(add-hook 'exwm-update-title-hook 'jao-exwm-rename-buffer/title) + +;;; Float windows +(defvar jao-exwm-max-x (x-display-pixel-width)) +(defvar jao-exwm-max-y (x-display-pixel-height)) + +(defun jao-exwm--float-to (x y &optional w h) + (let* ((w (or w (frame-pixel-width))) + (h (or h (frame-pixel-height))) + (x (if (< x 0) (- jao-exwm-max-x (- x) w) x)) + (y (if (< y 0) (- jao-exwm-max-y (- y) h) y)) + (p (or (frame-parameter nil 'jao-position) (frame-position)))) + (exwm-floating-move (- x (car p)) (- y (cdr p))) + (exwm-layout-enlarge-window-horizontally (- w (frame-pixel-width))) + (exwm-layout-enlarge-window (- h (frame-pixel-height))) + (set-frame-parameter nil 'jao-position (cons x y)))) + +(defun jao-exwm--center-float (&optional w h) + (interactive) + (let* ((mx jao-exwm-max-x) + (my jao-exwm-max-y) + (w (or w (frame-pixel-width))) + (h (or h (/ (* w my) mx)))) + (jao-exwm--float-to (/ (- mx w) 2) (/ (- my h) 2) w h))) + +(defun jao-exwm--setup-float () + (set-frame-parameter nil 'jao-position nil) + (cond ((member exwm-class-name '("firefox" "Firefox" "Sofice")) + (jao-exwm--center-float 900 600)) + ((member exwm-class-name '("mpv" "vlc")) + (jao-exwm--center-float 1200)))) + +(defvar jao-exwm-floating-classes '("mpv" "vlc")) +(setq jao-exwm-floating-classes nil) + +(defun jao-exwm--maybe-float () + (when (member exwm-class-name jao-exwm-floating-classes) + (when (not exwm--floating-frame) + (exwm-floating-toggle-floating)))) + +(add-hook 'exwm-floating-setup-hook #'jao-exwm--setup-float) +(add-hook 'exwm-manage-finish-hook #'jao-exwm--maybe-float) + +;; Minibuffer and system tray +(setq jao-minibuffer-frame-width 271) +(add-hook 'exwm-workspace-switch-hook #'jao-minibuffer-refresh) + +(require 'exwm-systemtray) +(exwm-systemtray-mode 1) + +(defun jao-exwm--watch-tray (sym newval op where) + (setq jao-minibuffer-right-margin (* 2 (length newval))) + (jao-minibuffer-refresh)) + +(add-variable-watcher 'exwm-systemtray--list #'jao-exwm--watch-tray) + +;; Switch to buffer / app +(defvar-local jao-exwm--name nil) +(defvar jao-exwm--current-name nil) + +(defun jao-exwm--check-name (name) + (or (string= jao-exwm--name name) + (string= (buffer-name) name) + (string= exwm-class-name name) + (string= exwm-title name))) + +(defun jao-exwm-find-class-buffer (cln) + (if (jao-exwm--check-name cln) + (current-buffer) + (let* ((cur-buff (current-buffer)) + (bfs (seq-filter (lambda (b) + (and (not (eq b cur-buff)) + (with-current-buffer b + (jao-exwm--check-name cln)))) + (buffer-list)))) + (when (car bfs) (car (reverse bfs)))))) + +(defun jao-exwm-switch-to-class/title (cln) + (interactive) + (when cln + (if (jao-exwm--check-name cln) + (current-buffer) + (when-let ((b (jao-exwm-find-class-buffer cln))) + (pop-to-buffer b))))) + +(defun jao-exwm-switch-to-next-class () + (interactive) + (jao-exwm-switch-to-class/title exwm-class-name)) + +(defun jao-exwm-switch-to-next-x () + (interactive) + (let ((bfs (seq-filter (lambda (b) + (with-current-buffer b + (derived-mode-p 'exwm-mode))) + (buffer-list (window-frame))))) + (when (car bfs) (switch-to-buffer (car (reverse bfs)))))) + +;;; App runner helpers +(defun jao-exwm-run (command) + (interactive + (list (read-shell-command "$ " + (if current-prefix-arg + (cons (concat " " (buffer-file-name)) 0) + "")))) + (setq jao-exwm--current-name nil) + (start-process-shell-command command nil command)) + +(defmacro jao-exwm-runner (&rest args) + `(lambda () (interactive) (start-process "" nil ,@args))) + +(defun jao-exwm-workspace (n) + (if jao-exwm--use-afio + (jao-afio-goto-nth n) + (exwm-workspace-switch-create n))) + +(defmacro jao-def-exwm-runner (name ws class &rest args) + `(defun ,name (&rest other-args) + (interactive) + ,@(when ws `((jao-exwm-workspace ,ws))) + (if (jao-exwm-switch-to-class/title ,class) + ,(cond ((equal ws -1) '(delete-other-windows)) + ((stringp (car args)) (cdr args)) + (t args)) + (setq jao-exwm--current-name ,class) + ,(if (stringp (car args)) + `(start-process-shell-command ,(car args) + "* exwm - console *" + (string-join (append (list ,@args) + other-args) + " ")) + args)))) + +(defmacro jao-def-exwm-toggler (name ws class &rest args) + (let ((toggler (intern (format "%s*" name))) + (arg (gensym))) + `(progn (jao-def-exwm-runner ,name ,ws ,class ,@args) + (defun ,toggler (,arg) + (interactive "P") + (if (and (not ,arg) (equal exwm-class-name ,class)) + (jao-afio-toggle) + (,name)))))) + +(defun jao-exwm--send-str (str) + (dolist (k (string-to-list (kbd str))) + (exwm-input--fake-key k))) + +;;; Runners +(jao-def-exwm-runner jao-exwm-vlc 4 "VLC" "vlc") + +(jao-def-exwm-runner jao-exwm-slack 0 "Slack" "slack") +(jao-def-exwm-runner jao-exwm-signal 0 "Signal" "signal-desktop") + +(jao-def-exwm-runner jao-exwm-proton-bridge 0 "*proton-bridge*" "protonmail-bridge") + +;; (jao-def-exwm-runner jao-exwm-htop 0 "htop-xterm" +;; "xterm" "-title" "htop-xterm" "-e" "htop") +(jao-def-exwm-runner jao-exwm-htop 0 "htop" jao-term-htop) + +;; (jao-def-exwm-runner jao-exwm-aptitude 0 "aptitude-xterm" +;; "xterm" "-title" "aptitude-xterm" "-e" "aptitude") +(jao-def-exwm-runner jao-exwm-aptitude 0 "aptitude" jao-term-aptitude) + +(jao-def-exwm-runner jao-exwm-blueman 0 "Blueman-manager" "blueman-manager") +(jao-def-exwm-runner jao-exwm-ncmpcpp 0 "ncmpcpp" "xterm" "-e" "ncmpcpp" "-p" "6669") +(jao-def-exwm-runner jao-exwm-mpc 0 "*MPC-Status*" mpc) + +(jao-def-exwm-runner jao-exwm-proton-vpn 0 "*pvpn*" proton-vpn-status) +(jao-def-exwm-runner jao-exwm-enwc 0 "*ENWC*" enwc) +(jao-def-exwm-runner jao-exwm-bluetooth 0 "*Bluetooth*" bluetooth-list-devices) +(jao-def-exwm-runner jao-exwm-packages 0 "*Packages*" list-packages nil) +(jao-def-exwm-runner jao-exwm-proced 0 "*Proced*" proced) + +(jao-def-exwm-runner jao-exwm-open-with-zathura nil nil "zathura" (buffer-file-name)) +(jao-def-exwm-runner jao-exwm-open-with-mupdf nil nil "mupdf" (buffer-file-name)) +(jao-def-exwm-runner jao-exwm-xterm 0 nil "xterm") + +;; (jao-def-exwm-toggler jao-exwm-tidal -1 "tidal-hifi" "tidal-hifi") +;; (jao-def-exwm-toggler jao-exwm-spt -1 "spt" "kitty" "-e" "spt") +;; (defalias 'jao-streaming-list #'jao-exwm-spt*) + +(defun jao-exwm-import-screen (&optional area) + (interactive "P") + (when (not (file-directory-p "/tmp/screenshot")) + (make-directory "/tmp/screenshot")) + (let ((c (format "import %s %s" + (if area "" "-window root") + "/tmp/screenshot/$(date +'%g%m%d-%H%M%S').png"))) + (start-process-shell-command "import" "* exwm - console *" c))) + +;;; Zathura support +(defun jao-zathura--buffer-p (b) + (string= "Zathura" (or (buffer-local-value 'exwm-class-name b) ""))) + +(defun jao-zathura--buffers () + (seq-filter #'jao-zathura--buffer-p (buffer-list))) + +(defun jao-zathura--file-info (b) + (with-current-buffer b + (jao-pdf-zathura-file-info (or exwm-title "")))) + +(defun jao-zathura-goto-page (page-no) + (jao-exwm--send-str (format "%sg" page-no))) + +(defun jao-zathura-open-doc (&optional file-name page-no height) + (interactive) + (let* ((file-name (expand-file-name (or file-name (buffer-file-name)))) + (buffer (seq-find `(lambda (b) + (string= ,file-name + (car (jao-zathura--file-info b)))) + (jao-zathura--buffers))) + (page-no (or page-no (jao-doc-view-current-page)))) + (if jao-exwm--use-afio (jao-afio-goto-docs) (jao-exwm--goto-docs)) + (if (not buffer) + (jao-exwm-run (if page-no + (format "zathura -P %s '%s'" page-no file-name) + (format "zathura '%s'" file-name))) + (pop-to-buffer buffer) + (when page-no (jao-zathura-goto-page page-no))) + (current-buffer))) + +(defun jao-exwm--zathura-setup () + (when (and (string= exwm-class-name "Zathura") + (not jao-pdf--outline)) + (let ((info (jao-zathura--file-info (current-buffer)))) + (jao-doc-session-mark (car info)) + (jao-doc-session-save) + (doc-view-imenu-index (car info) #'jao-zathura-goto-page)))) + +(add-hook 'exwm-update-title-hook #'jao-exwm--zathura-setup t) + +(defun jao-exwm-pdf-zathura-close-all () + (interactive) + (dolist (b (jao-zathura--buffers)) + (ignore-errors + (switch-to-buffer b) + (jao-exwm--send-str "q"))) + t) + +(defun jao-exwm-zathura-goto-org (&optional arg) + (interactive "P") + (when-let ((info (jao-zathura--file-info (current-buffer)))) + (when-let ((file (jao-org-find-for-pdf (car info)))) + (let ((newp (not (file-exists-p file)))) + (when (or arg newp) (org-store-link nil t)) + (find-file-other-window file) + (when newp + (jao-org-insert-doc-skeleton) + (org-insert-link)))))) + +(defun jao-exwm-zathura-goto-org* () + (interactive) + (jao-exwm-zathura-goto-org t)) + +(defun jao-exwm-org-store-zathura-link () + (when-let ((info (jao-zathura--file-info (current-buffer)))) + (let* ((file-name (car info)) + (page (cadr info)) + (desc (jao-pdf-section-title page file-name))) + (jao-org-links-store-pdf-link file-name page desc)))) + +(defun jao-exwm-pdf-enable-zathura () + (interactive) + (add-hook 'kill-emacs-query-functions #'jao-exwm-pdf-zathura-close-all t) + (setq jao-browse-doc-use-emacs-p nil) + (setq jao-org-open-pdf-fun #'jao-zathura-open-doc) + (setq jao-org-links-pdf-store-fun #'jao-exwm-org-store-zathura-link) + (setq jao-open-doc-fun #'jao-zathura-open-doc)) + +(defun jao-exwm-pdf-disable-zathura () + (interactive) + (remove-hook 'kill-emacs-query-functions #'jao-exwm-pdf-zathura-close-all) + (setq jao-browse-doc-use-emacs-p t) + (setq jao-org-open-pdf-fun #'jao-find-or-open) + (setq jao-org-links-pdf-store-fun nil) + (setq jao-open-doc-fun #'jao-find-or-open)) + +(defun jao-exwm-org-to-pdf-file () + (expand-file-name (concat "doc/" (file-name-base buffer-file-name) ".pdf") + (file-name-directory jao-org-notes-dir))) + +(defun jao-exwm-zathura-goto-pdf () + (interactive) + (if jao-browse-doc-use-emacs-p + (jao-org-goto-pdf) + (when-let (pdf (jao-exwm-org-to-pdf-file)) + (jao-zathura-open-doc pdf)))) + +(with-eval-after-load "org" + (define-key org-mode-map (kbd "C-c o") #'jao-exwm-zathura-goto-pdf)) + +(when (not jao-browse-doc-use-emacs-p) + (jao-exwm-pdf-enable-zathura)) + +(defun jao-exwm-select-pdf () + (interactive) + (let ((b (read-buffer "Document: " nil t + (lambda (b) + (let ((b (cdr b))) + (or (jao-zathura--buffer-p b) + (member (buffer-local-value 'major-mode b) + '(pdf-view-mode doc-view-mode)))))))) + (jao-afio-goto-docs) + (pop-to-buffer b))) + + +(jao-transient-major-mode+ doc-view + ["External viewers" + ("z" "open with zathura" jao-zathura-open-doc) + ("m" "open with mupdf" jao-exwm-open-with-mupdf)]) + +;;; Firefox support +(jao-def-exwm-toggler jao-exwm-firefox -1 "firefox" "firefox") + +(defun jao-exwm-browse-with-firefox (&rest args) + (jao-exwm-firefox) + (apply #'browse-url-firefox args)) + +(setq browse-url-secondary-browser-function #'jao-exwm-browse-with-firefox) + +(defun jao-exwm-kill-firefox-url () + (interactive) + (when-let (b (jao-exwm-find-class-buffer "Firefox")) + (let ((cb (current-buffer))) + (switch-to-buffer b) + (jao-exwm--send-str "yy") + (prog1 (current-kill 1) + (switch-to-buffer cb))))) + +;;; Transients +(defun jao-exwm--floating-p () exwm--floating-frame) +(defun jao-exwm--m0-5 () (interactive nil exwm-mode) (exwm-floating-move 0 -5)) +(defun jao-exwm--m05 () (interactive nil exwm-mode) (exwm-floating-move 0 5)) +(defun jao-exwm--m-50 () (interactive nil exwm-mode) (exwm-floating-move -5 0)) +(defun jao-exwm--m50 () (interactive nil exwm-mode) (exwm-floating-move 5 0)) +(defun jao-exwm--e-5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window -5)) +(defun jao-exwm--e5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window 5)) +(defun jao-exwm--eh5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window 5 t)) +(defun jao-exwm--eh-5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window -5 t)) +(defun jao-exwm--tl () (interactive nil exwm-mode) (jao-exwm--float-to 20 20)) +(defun jao-exwm--tr () (interactive nil exwm-mode) (jao-exwm--float-to -20 20)) +(defun jao-exwm--bl () (interactive nil exwm-mode) (jao-exwm--float-to 20 -20)) +(defun jao-exwm--br () (interactive nil exwm-mode) (jao-exwm--float-to -20 -20)) + +(defun jao-exwm--def-center-float () + (interactive) + (exwm-floating-toggle-floating) + (jao-exwm--center-float 900 600)) + +(transient-define-prefix jao-transient-float () + "Operations on EXWM floating windows." + :transient-non-suffix 'transient--do-quit-one + [["Float" + ("f" "float" exwm-floating-toggle-floating) + ("F" "full" exwm-layout-toggle-fullscreen) + ("c" "center" jao-exwm--center-float :if jao-exwm--floating-p) + ("c" "float and resize" jao-exwm--def-center-float + :if-not jao-exwm--floating-p) + ("x" "hide" exwm-floating-hide :if jao-exwm--floating-p)] + ["Slide" :if jao-exwm--floating-p + ("k" "up" jao-exwm--m0-5 :transient t) + ("j" "down" jao-exwm--m05 :transient t) + ("h" "left" jao-exwm--m-50 :transient t) + ("l" "right" jao-exwm--m50 :transient t)] + ["Resize" :if jao-exwm--floating-p + ("K" "up" jao-exwm--e5 :transient t) + ("J" "down" jao-exwm--e-5 :transient t) + ("H" "left" jao-exwm--eh5 :transient t) + ("L" "right" jao-exwm--eh-5 :transient t)] + ["Nudge" :if jao-exwm--floating-p + ("t" "top-left" jao-exwm--tl) + ("T" "top-right" jao-exwm--tr) + ("b" "bottom-left" jao-exwm--bl) + ("B" "bottom-right " jao-exwm--br)]]) + +(defun jao-exwm--buffer () + (interactive) + (jao-buffer-same-mode 'exwm-mode nil 'exwm-workspace-switch-to-buffer)) + +;;; Keybindings +(define-key exwm-mode-map [?\C-q] #'exwm-input-send-next-key) +(define-key exwm-mode-map [?\s-f] #'jao-transient-float) +(define-key exwm-mode-map (kbd "C-c o") #'jao-exwm-zathura-goto-org) +(define-key exwm-mode-map (kbd "C-c O") #'jao-exwm-zathura-goto-org*) +(define-key exwm-mode-map (kbd "M-o") #'jao-afio-toggle) +(define-key exwm-mode-map (kbd "M-p") #'jao-prev-window) + +(setq + exwm-input-global-keys + '(([?\s-0] . jao-afio-goto-scratch) + ([?\s-1] . jao-afio-goto-main) + ([?\s-2] . jao-afio-goto-mail) + ([?\s-3] . jao-afio-goto-www) + ([?\s-4] . jao-afio-goto-docs) + ([?\s-5] . jao-afio-goto-chats) + ([?\s-A] . jao-org-agenda) + ([?\s-a] . jao-first-window) + ([?\s-b] . jao-transient-org-blog) + ([?\s-d] . jao-exwm-tidal*) + ([?\s-e] . jao-exwm-firefox*) + ([?\s-m] . jao-transient-media) + ;; ([?\s-O] . switch-window-then-swap-buffer) + ([?\s-o] . jao-afio-toggle) + ([?\s-p] . jao-prev-window) + ([?\s-R] . app-launcher-run-app) + ([?\s-r] . jao-transient-recoll) + ([?\s-s] . jao-transient-streaming) + ([?\s-n] . jao-transient-ednc) + ([?\s-t] . eat) + ([?\s-w] . jao-transient-utils) + ([?\s-z] . jao-transient-sleep) + ([XF86AudioMute] . jao-mixer-master-toggle) + ([XF86AudioPlay] . jao-player-toggle) + ([XF86AudioPause] . jao-player-toggle) + ([XF86AudioNext] . jao-player-next) + ([XF86AudioPrev] . jao-player-previous) + ([XF86AudioStop] . jao-player-stop) + ([XF86AudioRaiseVolume] . jao-mixer-master-up) + ([XF86AudioLowerVolume] . jao-mixer-master-down) + ([XF86MonBrightnessUp] . jao-bright-up) + ([XF86MonBrightnessDown] . jao-bright-down) + ([?\s-\`] . jao-exwm-switch-to-next-x) + ([s-tab] . jao-exwm-switch-to-next-class) + ([print] . jao-exwm-import-screen) + ([f5] . jao-weather) + ([f6] . jao-toggle-audio-applet) + ([f8] . jao-toggle-nm-applet) + ([f9] . jao-bright-show))) + +;; (customize-set-variable 'exwm-input-global-keys exwm-input-global-keys) +(exwm-wm-mode) + +;;; . +(provide 'jao-custom-exwm) diff --git a/custom/jao-custom-gnus.el b/custom/jao-custom-gnus.el new file mode 100644 index 0000000..ce77285 --- /dev/null +++ b/custom/jao-custom-gnus.el @@ -0,0 +1,800 @@ +;; gnus configuration -*- lexical-binding: t -*- + +;;; features +(defvar jao-gnus-use-local-imap nil) +(defvar jao-gnus-use-leafnode nil) +(defvar jao-gnus-use-gandi-imap nil) +(defvar jao-gnus-use-pm-imap nil) +(defvar jao-gnus-use-gmane nil) +(defvar jao-gnus-use-nnml nil) +(defvar jao-gnus-use-maildirs nil) +(defvar jao-notmuch-enabled nil) +(defvar jao-gnus-nnml-group-params nil) + +;;; directories +(defun jao-gnus-dir (dir) + (expand-file-name dir gnus-home-directory)) + +(setq smtpmail-queue-dir (jao-gnus-dir "Mail/queued-mail/")) + +(setq mail-source-directory (jao-gnus-dir "Mail/") + message-directory (jao-gnus-dir "Mail/")) + +(setq gnus-default-directory (expand-file-name "~") + gnus-startup-file (jao-gnus-dir "newsrc") + gnus-agent-directory (jao-gnus-dir "News/agent") + gnus-home-score-file (jao-gnus-dir "scores") + gnus-article-save-directory (jao-gnus-dir "saved/") + nntp-authinfo-file (jao-gnus-dir "authinfo") + nnmail-message-id-cache-file (jao-gnus-dir "nnmail-cache") + nndraft-directory (jao-gnus-dir "drafts") + nnrss-directory (jao-gnus-dir "rss")) + +;;; looks +;;;; verbosity +(setq gnus-verbose 4) +;;;; geometry +(defvar jao-gnus-use-three-panes t) +(defvar jao-gnus-groups-width 50) +(defvar jao-gnus-wide-width 190) + +(setq gnus-use-trees nil + gnus-generate-tree-function 'gnus-generate-horizontal-tree + gnus-tree-minimize-window nil) + +(when jao-gnus-use-three-panes + + ;; (dolist (m '(calendar-mode org-agenda-mode gnus-group-mode)) + ;; (add-to-list 'display-buffer-alist `((major-mode . ,m) (dedicated t)))) + + (setq calendar-left-margin 6) + + (let ((side-bar '(vertical 1.0 + ("inbox.org" 0.4) + ("*Org Agenda*" 1.0) + ("*Calendar*" 8))) + (wide-len jao-gnus-wide-width) + (groups-len jao-gnus-groups-width) + (summary-len (- jao-gnus-wide-width jao-gnus-groups-width))) + (gnus-add-configuration + `(article + (horizontal 1.0 + (vertical ,groups-len (group 1.0)) + (vertical ,summary-len + (summary 0.25 point) + (article 1.0)) + ,side-bar))) + + (gnus-add-configuration + `(group (horizontal 1.0 (group ,wide-len point) ,side-bar))) + + (gnus-add-configuration + `(message (horizontal 1.0 (message ,wide-len point) ,side-bar))) + + (gnus-add-configuration + `(reply-yank (horizontal 1.0 (message ,wide-len point) ,side-bar))) + + (gnus-add-configuration + `(summary + (horizontal 1.0 + (vertical ,groups-len (group 1.0)) + (vertical ,summary-len (summary 1.0 point)) + ,side-bar))) + + (gnus-add-configuration + `(reply + (horizontal 1.0 + (message ,(- wide-len 100) point) + (article 100) + ,side-bar))))) + +;;;; no blue icon +(advice-add 'gnus-mode-line-buffer-identification :override #'identity) +(setq gnus-mode-line-image-cache nil) + +;;; search +(setq gnus-search-use-parsed-queries nil + gnus-search-notmuch-raw-queries-p nil + gnus-permanently-visible-groups "^nnselect:.*" + gnus-search-ignored-newsgroups "nndraft.*\\|nnselect.*") + +(with-eval-after-load "gnus-search" + (defclass gnus-search-recoll (gnus-search-indexed) + ((separator :type string :initform ".") + (program :initform "recoll") + (raw-queries-p :initform t))) + + (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-recoll)) + (prog1 (and (looking-at "^file://\\(.+\\)$") (list (match-string 1) 100)) + (forward-line 1))) + + (cl-defmethod gnus-search-transform-expression ((_engine gnus-search-recoll) + expr) + expr) + + (cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-recoll) + (qstring string) + query + &optional groups) + (let* ((subdir (slot-value engine 'remove-prefix)) + (sep (slot-value engine 'separator)) + (gdirs (mapcar (lambda (g) + (let ((g (gnus-group-short-name g))) + (replace-regexp-in-string "\\." sep g))) + (or groups + (and (not (string= "" subdir)) (list subdir))))) + (dirsq (and gdirs + (concat "(" + (mapconcat (lambda (d) (format "dir:%s" d)) + gdirs " OR ") + ")"))) + (qstring (if (string-prefix-p "id:" qstring) + (replace-regexp-in-string "<\\|>" "\"" qstring) + qstring)) + (qstring (if (cdr (assoc 'thread query)) + (concat qstring " OR " + (replace-regexp-in-string "id:\"" "ref:\"" + qstring)) + qstring)) + (qstring (replace-regexp-in-string " or " " OR " qstring)) + (qstring (replace-regexp-in-string " and " " AND " qstring)) + (q (format "mime:message %s (%s)" dirsq qstring))) + ;; (message "query is: %s -- %S" q query) + `("-b" "-t" "-q" ,q)))) + +;; (add-to-list 'gnus-parameters '("^nnselect:.*" (nnselect-rescan . t))) + +;;; news +(defvar jao-gnus-leafnode-spool "/var/spool/news/") +(setq gnus-select-method + (cond + (jao-gnus-use-leafnode + `(nntp "localhost" + (gnus-search-engine gnus-search-recoll + (remove-prefix ,jao-gnus-leafnode-spool) + (separator "/")))) + (jao-gnus-use-gmane '(nntp "news.gmane.io")) + (t '(nnnil "")))) + +(setq gnus-secondary-select-methods '()) + +(setq nnheader-read-timeout 0.02 + gnus-save-newsrc-file nil) ; .newsrc only needed by other newsreaders + +;; leafnode articles group parameters +(defvar jao-gnus-image-groups '("xkcd")) + +(defvar jao-gnus-leafnode-group-params + `((,(format "gwene\\..*%s.*" (regexp-opt jao-gnus-image-groups)) + (mm-html-inhibit-images nil) + (mm-html-blocked-images nil)) + ("\\(gmane\\|gwene\\)\\..*" + (jao-gnus--archiving-group "nnml:feeds.trove") + (posting-style (address "jao@gnu.org"))))) + +(when jao-gnus-use-leafnode + (dolist (p jao-gnus-leafnode-group-params) + (add-to-list 'gnus-parameters p t))) + +;;; mail +;;;; nnmail +(setq nnmail-treat-duplicates 'delete + nnmail-scan-directory-mail-source-once nil + nnmail-cache-accepted-message-ids t + nnmail-message-id-cache-length 100000 + nnmail-split-fancy-with-parent-ignore-groups nil + nnmail-use-long-file-names t + nnmail-crosspost t + nnmail-resplit-incoming t + nnmail-mail-splitting-decodes t + nnmail-split-methods 'nnmail-split-fancy) + +;;;; nnml +(setq gnus-message-archive-group nil + nnml-get-new-mail t + nnml-directory message-directory) + +(setq mail-sources + (let* ((pwd (auth-source-pick-first-password :host "proton-bridge")) + (mds (mapcar (lambda (f) + `(maildir :path ,(expand-file-name f "~/var/mail/"))) + '("local/" "feeds/"))) + (ims (mapcar (lambda (b) + `(imap :server "127.0.0.1" :port 1143 + :user "mail@jao.io" :password ,pwd + :stream starttls :predicate "1:*" + :fetchflag "\\Deleted \\Seen" + :mailbox ,(concat "Labels/#" b))) + '("inbox" "drivel" "hacking" "bills" + "bigml" "prog" "words")))) + (append mds ims))) + +(when jao-gnus-use-nnml + (add-to-list + 'gnus-secondary-select-methods + ;; `(nnml "" (gnus-search-engine gnus-search-recoll + ;; (remove-prefix ,(jao-gnus-dir "Mail/")))) + `(nnml "" (gnus-search-engine gnus-search-notmuch + (remove-prefix "/home/jao/var/mail/gnus"))))) + +(when jao-gnus-use-nnml + (dolist (p jao-gnus-nnml-group-params) + (add-to-list 'gnus-parameters p t))) + +;;;; imap +(setq nnimap-quirks nil) + +(when jao-gnus-use-local-imap + (add-to-list 'gnus-secondary-select-methods + `(nnimap "" (nnimap-address "localhost")))) + +(when jao-gnus-use-pm-imap + (add-to-list 'gnus-secondary-select-methods + '(nnimap "pm" + (nnimap-address "127.0.0.1") + (nnimap-stream network) + (nnimap-server-port 1143)))) + +(when jao-gnus-use-gandi-imap + (add-to-list 'gnus-secondary-select-methods + '(nnimap "gandi" (nnimap-address "mail.gandi.net")))) + +;;; groups +(setq gnus-group-line-format + " %m%S%p%3y%P%* %~(pad-right 30)G %B\n" + ;; " %m%S%p%P:%~(pad-right 35)c %3y %B\n" + ;; " %m%S%p%3y%P%* %~(pad-right 30)C %B\n" + gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" + gnus-group-uncollapsed-levels 2 + gnus-auto-select-subject 'unread + gnus-large-newsgroup 2000) + +(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp) +(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) + +;;; rss +(setq nnrss-use-local t ;; M-x nnrss-generate-download-script + nnrss-ignore-article-fields '(category + dc:creator + dc:date + enclosure + guid + link + media:content + media:thumbnail + media:title + post-id + pubDate + slash:comments)) + +(add-to-list 'gnus-parameters `(,(format "nnrss:%s.*" + (regexp-opt jao-gnus-image-groups t)) + (mm-html-inhibit-images nil) + (mm-html-blocked-images nil))) +;;; summary +;;;; configuration +(setq gnus-summary-ignore-duplicates t + gnus-suppress-duplicates t + ;; gnus-summary-ignored-from-addresses jao-mails-regexp + gnus-process-mark-toggle t + gnus-auto-select-next 'almost-quietly) + +;;;; threading +(setq gnus-face-1 'jao-gnus-face-tree + gnus-show-threads t + gnus-thread-hide-subtree t + gnus-build-sparse-threads nil + gnus-refer-thread-use-search t + gnus-summary-make-false-root 'adopt + gnus-summary-gather-subject-limit nil ;; 120 + gnus-summary-thread-gathering-function #'gnus-gather-threads-by-subject + gnus-sort-gathered-threads-function 'gnus-thread-sort-by-date + gnus-thread-sort-functions '(gnus-thread-sort-by-date)) + +(defun jao-fix-protonmail-references (header) + (let ((references (mail-header-references header))) + (setf (mail-header-references header) + (mapconcat #'(lambda (x) + (if (string-match "protonmail.internalid" x) "" x)) + (gnus-split-references references) + " ")) + header)) + +(setq gnus-alter-header-function 'jao-fix-protonmail-references) + +;;;; search on enter nnselect +(defun jao-gnus--maybe-reselect (&rest _i) + (when (string-match-p "^nnselect" (or (gnus-group-name-at-point) "")) + (save-excursion (gnus-group-get-new-news-this-group)))) + +(advice-add 'gnus-group-select-group :before #'jao-gnus--maybe-reselect) + +;;;; summary line +(setq gnus-not-empty-thread-mark ?↓) ; ↓) ?· +(setq jao-gnus--summary-line-fmt + (concat "%%U %%*%%R %%uj " + "[ %%~(max-right 23)~(pad-right 23)uf " + " %%I%%~(pad-left 2)t ] %%s" + "%%-%s=" + "%%~(max-right 8)~(pad-left 8)&user-date;" + "\n")) + +(defun jao-gnus--set-summary-line (&optional w) + (let* ((d (if jao-gnus-use-three-panes (+ jao-gnus-groups-width 11) 12)) + (w (- (or w (window-width)) d))) + (setq gnus-summary-line-format (format jao-gnus--summary-line-fmt w)))) + +(add-hook 'gnus-select-group-hook 'jao-gnus--set-summary-line) +;; (jao-gnus--set-summary-line 187) + +(add-to-list 'nnmail-extra-headers 'Cc) +(add-to-list 'nnmail-extra-headers 'BCc) + +(use-package gnus-sum + :config + (add-to-list 'gnus-extra-headers 'Cc) + (add-to-list 'gnus-extra-headers 'BCc)) + + +(defun gnus-user-format-function-j (headers) + (let ((to (gnus-extra-header 'To headers))) + (if (string-match jao-mails-regexp to) + (if (string-match "," to) "¬" "»") ;; "~" "=") + (if (or (string-match jao-mails-regexp + (gnus-extra-header 'Cc headers)) + (string-match jao-mails-regexp + (gnus-extra-header 'BCc headers))) + "¬" ;; "~" + " ")))) + +(defconst jao-gnus--news-rx + (concat (regexp-opt '("ElDiaro.es " + "ElDiario.es - ElDiario.es: " + "The Guardian: " + "Aeon | a world of ideas: " + "Planet Debian: ")) + "\\|The Conversation – Articles (.+): " + "\\|unofficial mirror of [^:]+: " + "\\|[gq].+ updates on arXiv.org: ")) + +(defun gnus-user-format-function-f (headers) + (let* ((from (gnus-header-from headers)) + (from (gnus-summary-extract-address-component from)) + (from (replace-regexp-in-string jao-gnus--news-rx "" from))) + from)) + +(setq gnus-user-date-format-alist + '(((gnus-seconds-today) . "%H:%M") + ((+ 86400 (gnus-seconds-today)) . "'%H:%M") + ;; (604800 . "%a %H:%M") ;; that's one week + ((gnus-seconds-month) . "%a %d") + ((gnus-seconds-year) . "%b %d") + (t . "%b '%y"))) + +;;;; moving messages around +(defvar-local jao-gnus--spam-group nil) +(defvar-local jao-gnus--archiving-group nil) +(defvar-local jao-gnus--archive-as-copy-p nil) + +(defvar jao-gnus--last-move nil) +(defun jao-gnus-move-hook (a headers c to d) + (setq jao-gnus--last-move (cons to (mail-header-id headers)))) +(defun jao-gnus-goto-last-moved () + (interactive) + (when jao-gnus--last-move + (when (eq major-mode 'gnus-summary-mode) (gnus-summary-exit)) + (gnus-group-goto-group (car jao-gnus--last-move)) + (gnus-group-select-group) + (gnus-summary-goto-article (cdr jao-gnus--last-move) nil t))) +(add-hook 'gnus-summary-article-move-hook 'jao-gnus-move-hook) + +(defun jao-gnus-archive (follow) + (interactive "P") + (if jao-gnus--archiving-group + (progn + (if (or jao-gnus--archive-as-copy-p + (not (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name))) + (gnus-summary-copy-article nil jao-gnus--archiving-group) + (gnus-summary-move-article nil jao-gnus--archiving-group)) + (when follow (jao-gnus-goto-last-moved))) + (gnus-summary-mark-as-read) + (gnus-summary-delete-article))) + +(defun jao-gnus-archive-tickingly () + (interactive) + (gnus-summary-tick-article) + (jao-gnus-archive) + (when jao-gnus--archive-as-copy-p + (gnus-summary-mark-as-read))) + +(defun jao-gnus-show-tickled () + (interactive) + (gnus-summary-limit-to-marks "!")) + +(make-variable-buffer-local + (defvar jao-gnus--trash-group nil)) + +(defun jao-gnus-trash () + (interactive) + (gnus-summary-mark-as-read) + (if jao-gnus--trash-group + (gnus-summary-move-article nil jao-gnus--trash-group) + (gnus-summary-delete-article))) + +(defun jao-gnus-move-to-spam () + (interactive) + (gnus-summary-mark-as-read) + (gnus-summary-move-article nil jao-gnus--spam-group)) + +(define-key gnus-summary-mode-map "Ba" 'jao-gnus-archive) +(define-key gnus-summary-mode-map "BA" 'jao-gnus-archive-tickingly) +(define-key gnus-summary-mode-map "Bl" 'jao-gnus-goto-last-moved) + +(define-key gnus-summary-mode-map (kbd "B DEL") 'jao-gnus-trash) +(define-key gnus-summary-mode-map (kbd "B <backspace>") 'jao-gnus-trash) +(define-key gnus-summary-mode-map "Bs" 'jao-gnus-move-to-spam) +(define-key gnus-summary-mode-map "/!" 'jao-gnus-show-tickled) +(define-key gnus-summary-mode-map [f7] 'gnus-summary-force-verify-and-decrypt) + +;;;; saving emails +(setq gnus-default-article-saver 'gnus-summary-save-article-mail) +(defvar jao-gnus-file-save-directory (expand-file-name "~/tmp")) +(defun jao-gnus-file-save (newsgroup headers &optional last-file) + (expand-file-name (format "%s.eml" (mail-header-subject headers)) + jao-gnus-file-save-directory)) +(setq gnus-mail-save-name 'jao-gnus-file-save) + +;;;; arXiv capture +(use-package org-capture + :config + (add-to-list 'org-capture-templates + '("x" "arXiv" entry (file "notes/physics/arxiv.org") + "* %(jao-gnus-subject)\n\n %i\n\n %(jao-gnus-org-url)" + :immediate-finish t) + t) + (add-to-list 'org-capture-templates + '("X" "arXiv" entry (file "notes/physics/arxiv.org") + "* %(jao-gnus-subject)\n\n%(jao-gnus-org-paragraph \"%i\")" + :immediate-finish t) + t) + (org-capture-upgrade-templates org-capture-templates)) + +(defvar jao-gnus-org-url nil) +(defun jao-gnus-org-url () jao-gnus-org-url) +(defun jao-gnus-org-paragraph (x) + (with-temp-buffer + (insert " " (string-trim (or x "")) "\n ") + (goto-char 0) + (fill-paragraph) + (goto-char (point-max)) + (open-rectangle 0 (point)) + (concat (buffer-string) "\n " (or jao-gnus-org-url "")))) +(defvar jao-gnus-subject nil) +(defun jao-gnus-subject () jao-gnus-subject) + +(defun jao-gnus-arXiv-capture () + (interactive) + (unless (derived-mode-p '(gnus-summary-mode)) (gnus-article-show-summary)) + (setq jao-gnus-subject (gnus-summary-article-subject)) + (gnus-summary-select-article-buffer) + (gnus-article-goto-part 0) + (let ((transient-mark-mode t)) + (set-mark (point)) + (forward-paragraph) + (or (and (save-excursion + (when (re-search-forward "^Link" nil t) + (beginning-of-line) + (setq jao-gnus-org-url (org-eww-url-below-point)))) + (org-capture nil "X")) + (and (save-excursion + (when (re-search-forward "^URL: " nil t) + (setq jao-gnus-org-url (thing-at-point-url-at-point)))) + (org-capture nil "x")))) + (gnus-article-show-summary)) + +;;; article +;;;; config, headers +(setq mail-source-delete-incoming t) +(setq gnus-gcc-mark-as-read t) +(setq gnus-treat-display-smileys nil) +(setq gnus-treat-fill-long-lines nil) +(setq gnus-treat-fill-article 120) +(setq gnus-treat-fold-headers nil) +(setq gnus-treat-strip-leading-blank-lines t) +(setq gnus-article-auto-eval-lisp-snippets nil) +(setq gnus-posting-styles '((".*" (name "Jose A. Ortega Ruiz")))) +(setq gnus-single-article-buffer nil) +(setq gnus-article-update-lapsed-header 60) +(setq gnus-article-update-date-headers 60) + +(with-eval-after-load "gnus-art" + (setq gnus-visible-headers + (concat + gnus-visible-headers + "\\|^List-[iI][Dd]:\\|^X-Newsreader:\\|^X-Mailer:" + "\\|^User-Agent:\\|^X-User-Agent:\\|^X-RSS-Feed:"))) + +;;;; html and images +(setq gnus-button-url 'browse-url-generic + gnus-inhibit-images t + mm-discouraged-alternatives nil ;; '("text/html" "text/richtext") + mm-inline-large-images 'resize) + +(defvar-local jao-gnus--images nil) + +(defun jao-gnus--init-images () + (with-current-buffer gnus-article-buffer + (setq jao-gnus--images nil))) + +(add-hook 'gnus-select-article-hook #'jao-gnus--init-images) + +(defun jao-gnus-browse-html () + (interactive) + (let ((browse-url-browser-function jao-browse-url-external-function) + (browse-url-handlers nil) + (browse-url-default-handlers nil)) + (gnus-article-browse-html-article))) + +(defun jao-gnus-show-images () + (interactive) + (if window-system + (save-window-excursion + (gnus-summary-select-article-buffer) + (save-excursion + (if (and jao-afio-use-w3m (fboundp 'w3m-toggle-inline-images)) + (w3m-toggle-inline-images) + (setq jao-gnus--images (not jao-gnus--images)) + (if jao-gnus--images + (gnus-article-show-images) + (gnus-article-remove-images))))) + (jao-gnus-browse-html))) + +;;;; format from: + +(defvar jao-gnus--from-rx + (concat "From: \\\"?\\( *" jao-gnus--news-rx "\\)")) + +(defun jao-gnus-format-from () + (save-excursion + (goto-char (point-min)) + (when (re-search-forward jao-gnus--from-rx nil t) + (replace-match "" nil nil nil 1)))) + +(add-hook 'gnus-part-display-hook 'jao-gnus-format-from) + +;;;; follow links and enclosures +(defun jao-gnus-follow-link (&optional external) + (interactive "P") + (when (eq major-mode 'gnus-summary-mode) + (gnus-summary-select-article-buffer)) + (save-excursion + (goto-char (point-min)) + (when (or (search-forward-regexp "^Via: h" nil t) + (search-forward-regexp "^URL:[\n ]h" nil t) + (and (search-forward-regexp "^Link$" nil t) + (not (beginning-of-line)))) + (cond (external (jao-browse-with-external-browser)) + ((featurep 'jao-custom-eww) (eww (jao-url-around-point))) + (t (browse-url (jao-url-around-point))))))) + +(defun jao-gnus-from-eww (keep-eww-buffer) + (interactive "P") + (unless keep-eww-buffer (jao-eww-close)) + (jao-afio-goto-mail) + (gnus-article-show-summary)) + +(with-eval-after-load 'eww + (define-key eww-mode-map (kbd "h") #'jao-gnus-from-eww)) + +(defun jao-gnus-open-enclosure () + (interactive) + (save-window-excursion + (gnus-summary-select-article-buffer) + (save-excursion + (goto-char (point-min)) + (let ((offset (or (and (search-forward-regexp "^Enclosure: ?" nil t) 2) + (and (search-forward-regexp "^Enclosure$" nil t) -2)))) + (when offset (forward-char offset)) + (if-let ((url (jao-url-around-point))) + (jao-mpc-add-or-play-url url) + (error "No enclosure found")))))) + +;;;; delayed messages +(require 'gnus-util) +(gnus-delay-initialize) +(setq gnus-delay-default-delay "3h") +(eval-after-load "message" + '(setq message-draft-headers (remove 'Date message-draft-headers))) + +;;; daemon and exit +(setq gnus-interactive-exit t) +(defun jao-quit-gnus () (gnus-group-exit) t) +(add-hook 'kill-emacs-query-functions #'jao-quit-gnus) + +;; daemon config +(setq mail-user-agent 'gnus-user-agent) +(setq gnus-asynchronous t) +(setq gnus-use-article-prefetch nil) +(setq gnus-save-killed-list nil) +(setq gnus-check-new-newsgroups nil) + +(require 'gnus-demon) + +(defun jao-gnus--scan () + (let ((inhibit-message t)) + (gnus-demon-scan-news) + (jao-gnus--notify))) + +(defun jao-gnus-add-demon () + (interactive) + (gnus-demon-add-handler 'jao-gnus--scan 5 1)) + +(jao-gnus-add-demon) +(gnus-demon-init) + +;; this is, in theory, not needed; but at some point in the way to emacs +;; version 31 this idle timers have ceased to work after a sleep/awake cycle +(add-to-list 'jao-sleep-awake-functions #'jao-gnus-add-demon) + +;;; add-ons +;;;; notifications +;;;;; minibuffer +(defvar jao-gnus-tracked-groups + (let ((feeds (thread-first + (directory-files mail-source-directory nil "feeds\\.[^e]") + (seq-difference '("feeds.trove"))))) + `(("nnml:bigml\\.inbox" "B" jao-themes-f00) + ("nnml:bigml\\.alba" "A" jao-themes-f00) + ("nnml:bigml\\.ryou" "R" jao-themes-f00) + ("nnml:bigml\\.bugs" "b" jao-themes-error) + ("nnml:bigml\\.support" "S" default) + ("nnml:bigml\\.[^aibsr]" "W" jao-themes-dimm) + ("nnml:jao\\.\\(inbox\\|trove\\)" "I" jao-themes-f01) + ("nnml:jao.hacking" "H" jao-themes-dimm) + ("nnml:jao.write" "W" jao-themes-warning) + ("nnml:jao.[^ithw]" "J" jao-themes-dimm) + (,(format "^nnml:%s" (regexp-opt feeds)) "F" jao-themes-dimm) + ("feeds\\.e" "E" jao-themes-dimm) + ("nnml:local" "l" jao-themes-dimm) + ("nnrss:.*" "R" jao-themes-dimm) + ("^\\(gwene\\|gmane\\)\\." "N" jao-themes-dimm)))) + +(defun jao-gnus--unread-counts () + (seq-reduce (lambda (r g) + (let ((n (gnus-group-unread (car g)))) + (if (and (numberp n) (> n 0)) (cons (cons (car g) n) r) r))) + gnus-newsrc-alist + ())) + +(defun jao-gnus--unread-label (counts rx label face) + (let ((n (seq-reduce (lambda (n c) + (if (string-match-p rx (car c)) (+ n (cdr c)) n)) + counts + 0))) + (when (> n 0) `(:propertize ,(format "%s%d " label n) face ,face)))) + +(defvar jao-gnus--notify-strs ()) + +(defun jao-gnus--notify-strs () + (let ((counts (jao-gnus--unread-counts))) + (seq-filter #'identity + (seq-map (lambda (args) + (apply 'jao-gnus--unread-label counts args)) + jao-gnus-tracked-groups)))) + +(defun jao-gnus--notify () + (setq jao-gnus--notify-strs (jao-gnus--notify-strs)) + (jao-minibuffer-refresh)) + +(with-eval-after-load "jao-minibuffer" + (jao-minibuffer-add-variable 'jao-gnus--notify-strs -20)) + +(add-hook 'gnus-started-hook #'jao-gnus--notify) +;; (add-hook 'gnus-summary-exit-hook #'jao-gnus--notify) +(add-hook 'gnus-after-getting-new-news-hook #'jao-gnus--notify) + +;;;;; agenda and other updates on summary exit +(let ((exit-count 0)) + (defun jao-gnus--on-summary-exit () + (when (> (setq exit-count (+ 1 exit-count)) 20) + (setq exit-count 0) + (jao-org-agenda)) + (jao-gnus--notify))) + +(add-hook 'gnus-summary-exit-hook #'jao-gnus--on-summary-exit) +(add-hook 'gnus-exit-group-hook #'jao-gnus--notify) + +;;;; open mail file in gnus +(defun jao-gnus-file-to-group (file &optional maildir newsdir m-server n-server) + "Compute the Gnus group name from the given file name. + IN: /home/jao/.emacs.d/gnus/Mail/jao.trove/32, /home/jao/.emacs.d/gnus/Mail/ + OUT: nnml:jao.trove " + (let* ((maildir (or maildir message-directory)) + (newsdir (or newsdir jao-gnus-leafnode-spool)) + (m-server (or m-server "nnml")) + (n-server (or n-server "nntp+localhost")) + (nntp (and newsdir (string-match-p newsdir file))) + (g (directory-file-name (file-name-directory file))) + (g (replace-regexp-in-string (file-name-as-directory maildir) "" g)) + (g (replace-regexp-in-string (file-name-as-directory newsdir) "" g)) + (g (cond (nntp (concat n-server ":" g)) + ((file-name-directory g) + (replace-regexp-in-string "^\\([^/]+\\)/" + (concat m-server ":\\1/") + (file-name-directory g) t)) + (t (concat m-server ":" g)))) + (g (replace-regexp-in-string "/" "." g)) + (g (replace-regexp-in-string "[/.]$" "" g))) + (cond ((string-match ":$" g) (concat g "inbox")) + (nntp g) + (t (replace-regexp-in-string ":\\." ":" g))))) + +(defun jao-gnus-goto-file (filename &optional _page) + (let ((group (jao-gnus-file-to-group filename)) + (id (file-name-nondirectory filename))) + (if (and group id) + (org-gnus-follow-link group id) + (message "Couldn't get relevant info for switching to Gnus.")))) + +;;;; afio +(defun jao-gnus--on-afio-switch () + (when (derived-mode-p 'gnus-group-mode) + (let ((no (or (gnus-group-unread (gnus-group-group-name)) 0))) + (unless (> no 0) (gnus-group-first-unread-group))))) + +(add-hook 'jao-afio-switch-hook #'jao-gnus--on-afio-switch) + +(defun jao-gnus-refresh-workspace () + (interactive) + (save-window-excursion (calendar) (jao-org-agenda))) + +;;;; gnus-icalendar +(require 'ol-gnus) +(use-package gnus-icalendar + :demand t + :init (setq gnus-icalendar-org-capture-file + (expand-file-name "inbox.org" org-directory) + gnus-icalendar-org-capture-headline '("Appointments")) + :config (gnus-icalendar-org-setup)) + +;;;; bbdb +(with-eval-after-load "bbdb" + ;; (bbdb-initialize 'gnus 'message 'pgp) + (bbdb-mua-auto-update-init 'gnus) + (with-eval-after-load "gnus-sum" + (define-key gnus-summary-mode-map ":" 'bbdb-mua-annotate-sender) + (define-key gnus-summary-mode-map ";" 'bbdb-mua-annotate-recipients))) + +;;;; randomsig +(with-eval-after-load "randomsig" + (with-eval-after-load "gnus-sum" + (define-key gnus-summary-save-map "-" 'gnus/randomsig-summary-read-sig))) + +;;;; recoll +(unless jao-notmuch-enabled + (with-eval-after-load "org" + (org-link-set-parameters "message" :follow #'jao-gnus-goto-file)) + (with-eval-after-load "consult-recoll" + (add-to-list 'consult-recoll-open-fns + '("message/rfc822" . jao-gnus-goto-file)))) +;;;; notmuch +(use-package jao-notmuch-gnus + :demand t) + +(jao-load-path "consult-notmuch") + +(use-package consult-notmuch + :bind (:map gnus-group-mode-map ("S" . #'jao-gnus-consult-notmuch))) + +;;; keyboard shortcuts +(define-key gnus-article-mode-map "i" 'jao-gnus-show-images) +(define-key gnus-summary-mode-map "i" 'jao-gnus-show-images) +(define-key gnus-article-mode-map "\M-g" 'jao-gnus-follow-link) +(define-key gnus-summary-mode-map "\M-g" 'jao-gnus-follow-link) +(define-key gnus-summary-mode-map "v" 'scroll-other-window) +(define-key gnus-summary-mode-map "V" 'scroll-other-window-down) +(define-key gnus-summary-mode-map "X" 'jao-gnus-arXiv-capture) +(define-key gnus-summary-mode-map "e" 'jao-gnus-open-enclosure) +(define-key gnus-summary-mode-map "\C-l" nil) +(define-key gnus-group-mode-map "a" 'jao-gnus-refresh-workspace) diff --git a/custom/jao-custom-notmuch.el b/custom/jao-custom-notmuch.el new file mode 100644 index 0000000..42d9e12 --- /dev/null +++ b/custom/jao-custom-notmuch.el @@ -0,0 +1,658 @@ +;; -*- lexical-binding: t; -*- +;;; minibuffer +(defvar jao-notmuch-minibuffer-string "") + +(defvar jao-notmuch-minibuffer-queries + `((:name "" :query "tag:new and not tag:draft" :face jao-themes-f00) + (:name "B" :query "tag:new and tag:bigml and tag:inbox" :face default) + (:name "A" :query "tag:new and tag:alba" :face default) + (:name "b" :query "tag:new and tag:bigml and tag:bugs" + :face jao-themes-error) + (:name "S" :query "tag:new and tag:bigml and tag:support" :face default) + (:name "W" + :query "tag:new and tag:bigml and not tag:\"/support|bugs|inbox/\"" + :face default) + (:name "I" :query "tag:new and tag:jao and tag:inbox" :face jao-themes-warning) + (:name "W" :query "tag:new and tag:jao and tag:write" :face jao-themes-warning) + (:name "J" + :query ,(concat "tag:new and tag:jao and not " + "tag:\"/local|hacking|draft|inbox|prog|words|write/\"") + :face default) + (:name "H" :query "tag:new and tag:hacking and not tag:\"/emacs/\"") + (:name "E" :query "tag:new and tag:\"/emacs/\"") + (:name "l" :query "tag:new and tag:local") + (:name "F" :query "tag:new and tag:feeds and not tag:\"/emacs/\""))) + +(defun jao-notmuch-notify () + (let ((cnts (notmuch-hello-query-counts jao-notmuch-minibuffer-queries))) + (setq jao-notmuch-minibuffer-string + (mapconcat (lambda (c) + (propertize (format "%s%s" + (plist-get c :name) + (plist-get c :count)) + 'face (or (plist-get c :face) + 'jao-themes-dimm))) + cnts + " ")) + (jao-minibuffer-refresh))) + +(when jao-notmuch-enabled + (jao-minibuffer-add-variable 'jao-notmuch-minibuffer-string -20)) + +;;; saved searches +(defvar jao-notmuch--new "tag:\"/^(unread|new)$/\"") +(defvar jao-notmuch--newa (concat jao-notmuch--new " AND ")) + +(defun jao-notmuch--q (d0 d1 &optional k qs st) + (let ((q (or (when qs (mapconcat #'identity qs " AND ")) + (concat jao-notmuch--newa + (mapconcat (lambda (d) (when d (concat "tag:" d))) + (list d0 d1) " AND "))))) + (list :name (concat d0 (when (and d1 (not (string= "" d1))) "/") d1) + :key k :query q :search-type (or st 'tree) + :sort-order 'oldest-first))) + +(defun jao-notmuch--qn (d0 d1 k qs &optional st) + (jao-notmuch--q d0 d1 k (cons jao-notmuch--new qs) st)) + +(defun jao-notmuch--sq (tag &optional k d0 d1) + (jao-notmuch--qn (or d0 "feeds") (or d1 tag) k (list (concat "tag:" tag)))) + +(defun jao-notmuch-tree-widen-search () + (interactive) + (when-let ((query (notmuch-tree-get-query))) + (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))) + (notmuch-tree-close-message-window) + (notmuch-tree (string-replace jao-notmuch--newa "" query))))) + +(defun jao-notmuch-widen-searches (searches &optional extra) + (mapcar (lambda (s) + (let* ((q (plist-get s :query)) + (qs (string-replace jao-notmuch--newa "" q))) + (plist-put (copy-sequence s) :query (concat qs extra)))) + searches)) + +(defun jao-notmuch-hello--insert-searches (searches title) + (when-let (searches (notmuch-hello-query-counts searches)) + (let* ((cnt (when title + (seq-reduce (lambda (c q) + (+ c (or (plist-get q :count) 0))) + searches + 0))) + (title (if title (format "[ %d %s ]\n\n" cnt title) "\n")) + (notmuch-column-control 1.0)) + (widget-insert (propertize title 'face 'jao-themes-f00)) + (notmuch-hello-insert-buttons searches)))) + +(defmacro jao-notmuch-def-searches (name searches) + (declare (indent 1)) + (let ((name (and name (format "%s" name))) + (id (intern (format "jao-notmuch-%s-searches" (or name (gensym)))))) + `(progn (defvar ,id ,searches) + (defun ,id () (jao-notmuch-hello--insert-searches ,id ,name)) + (setq notmuch-saved-searches (append notmuch-saved-searches ,id)) + (add-to-list 'notmuch-hello-sections ',id t)))) + +(setq notmuch-hello-sections nil notmuch-saved-searches nil) + +(jao-notmuch-def-searches bigml + `(,(jao-notmuch--q "bigml" "inbox" "bi") + ,(jao-notmuch--q "bigml" "alba" "ba") + ,(jao-notmuch--q "bigml" "support" "bs") + ,(jao-notmuch--q "bigml" "bugs" "bb") + ,(jao-notmuch--q "bigml" "drivel" "bd") + ,(jao-notmuch--q "bigml" "lists" "bl"))) + +(jao-notmuch-def-searches inbox + `(,(jao-notmuch--q "jao" "inbox" "ji") + ,(jao-notmuch--qn "jao" "bills" "jb" '("tag:bills")) + ,(jao-notmuch--qn "jao" "write" "jw" '("tag:write")) + ,(jao-notmuch--q "jao" "drivel" "jd") + ,(jao-notmuch--q "jao" "mdk" "jm") + ,(jao-notmuch--qn "jao" "hacking" "jh" '("tag:hacking" "not tag:\"/emacs/\"")) + ,(jao-notmuch--qn "jao" "local" "jl" '("tag:local")))) + +(jao-notmuch-def-searches news + (mapcar #'jao-notmuch--sq '("news" "noticias" "fun" "words" "computers"))) + +(jao-notmuch-def-searches hacking + (mapcar #'jao-notmuch--sq '("xmobar" "geiser" "mdk" "mailutils" "notmuch"))) + +(jao-notmuch-def-searches prog + (append (mapcar #'jao-notmuch--sq + '( "lobsters" "clojure" "lisp" "scheme" + "haskell" "idris" "erlang" "pharo")) + `(,(jao-notmuch--qn "feeds" "prog" "fp" + '("tag:prog" "not tag:\"/emacs/\""))))) + +(jao-notmuch-def-searches emacs + `(,(jao-notmuch--sq "emacs" "ee" "emacs" "feeds") + ,(jao-notmuch--sq "emacs-help" "eh" "emacs" "help") + ,(jao-notmuch--sq "emacs-github" "eg" "emacs" "github") + ,(jao-notmuch--sq "emacs-devel" "ed" "emacs" "devel") + ,(jao-notmuch--sq "emacs-bugs" "eb" "emacs" "bugs") + ,(jao-notmuch--sq "emacs-diffs" "ec" "emacs" "diffs"))) + +(jao-notmuch-def-searches sci + (mapcar #'jao-notmuch--sq + '("philosophy" "math" "physics" "sci" "gr-qc" "quant-ph"))) + +(jao-notmuch-def-searches flags + (jao-notmuch-widen-searches notmuch-saved-searches " AND tag:flagged")) + +(jao-notmuch-def-searches nil + `(,(jao-notmuch--q "bml" "flagged" "rb" '("tag:flagged" "tag:bigml")) + ,(jao-notmuch--q "jao" "flagged" "rj" '("tag:flagged" "tag:jao")) + ,(jao-notmuch--q "feeds" "flagged" "rf" '("tag:flagged" "tag:feeds")))) + +(jao-notmuch-def-searches today + `(,(jao-notmuch--q "new" nil "nn" '("tag:new" "not tag:draft")) + ,(jao-notmuch--q "jao" "drafts" "d" '("tag:draft")) + ,(jao-notmuch--q "bml" "sent" "ts" + '("tag:bigml" "date:1d.." "tag:sent")) + ,(jao-notmuch--q "jao" "sent" "tS" + '("tag:\"/jao|hacking/\"" "date:1d.." "tag:sent")) + ,(jao-notmuch--q "bml" "today" "tb" + '("not tag:sent" "tag:bigml" "date:24h..")) + ,(jao-notmuch--q "jao" "today" "tj" + '("tag:jao" "date:24h.." + "not tag:\"/(sent|feeds|spam|local)/\"")))) + +(jao-notmuch-def-searches trove + (mapcar (lambda (m) (list :query (concat "tag:trove and tag:" m) + :name (concat "trove/" m) + :key (concat "t" (substring m 0 1)) + :search-type 'tree)) + '("jao" "hacking" "feeds" "bills"))) + +(jao-notmuch-def-searches nil + '((:query "not tag:trove and not tag:bigml" :name "jao/untroved" :search-type tree) + (:query "tag:sent and tag:bigml" :name "bigml/sent" :search-type tree) + (:query "tag:sent and not tag:bigml" :name "jao/sent" :search-type tree) + (:query "*" :name "messages" :search-type tree))) + +(defvar jao-notmuch-widened-searches + (jao-notmuch-widen-searches notmuch-saved-searches)) + +(defun jao-notmuch-jump-search (&optional widen) + (interactive "P") + (let ((notmuch-saved-searches + (if widen jao-notmuch-widened-searches notmuch-saved-searches))) + (notmuch-jump-search))) + +;;; tags +(defvar jao-notmuch--shared-tags + '("new" "unread" "flagged" "signed" "sent" "attachment" "forwarded" "inbox" + "encrypted" "gmane" "gnus" "feeds" "rss" "mce" "trove" "prog" "emacs")) + +(defun jao-notmuch--subtags (tag &rest excl) + (let* ((cmd (concat "notmuch search --output=tags tag:" tag)) + (ts (split-string (shell-command-to-string cmd)))) + (seq-difference ts (append jao-notmuch--shared-tags (cons tag excl))))) + +(setq notmuch-archive-tags '("+trove" "-new" "-drivel" "-words" "-inbox") + notmuch-show-mark-read-tags '("-new" "-unread") + notmuch-tag-formats + (let (;; (d `(:foreground ,(face-attribute 'jao-themes-dimm :foreground))) + (e `(:foreground ,(face-attribute 'jao-themes-error :foreground)))) + `(("unread") + ("signed") + ("new" "·") + ("replied" "↩" (propertize tag 'face '(:family "Fira Code"))) + ("sent" "🛪") + ("attachment" "📎") + ("deleted" "🗙" (propertize tag 'face '(:underline nil ,@e))) + ("flagged" "✓") + ("jao" "j") + ("bigml" "b") + ("feeds" "f") + ("lists" "l") + ("gmane" "g"))) + notmuch-tag-deleted-formats + '(("unread") + ("new") + ("flagged") + ("deleted") + (".*" (notmuch-apply-face tag 'notmuch-tag-deleted)))) + +(with-eval-after-load "notmuch-tag" + (advice-add #'notmuch-read-tag-changes + :filter-return (lambda (x) (mapcar #'string-trim x)))) + +;;; package +;; (add-to-list 'load-path "/usr/local/share/emacs/site-lisp/") +(jao-load-path "notmuch") + +(use-package notmuch + :init + (setq notmuch-address-use-company t + notmuch-address-command 'as-is + notmuch-always-prompt-for-sender t + notmuch-draft-folder "drafts" + notmuch-draft-quoted-tags '("part") + notmuch-fcc-dirs + '(("\\(support\\|education\\)@bigml.com" . nil) + ("mail@jao.io" . nil) + (".*@bigml.com" . "bigml -new -unread +sent +bigml") + (".*" . "jao -new -unread +sent +jao")) + notmuch-maildir-use-notmuch-insert t) + + :custom ((notmuch-address-internal-completion '(sent nil))) + + :config + + (add-hook 'message-send-hook #'notmuch-mua-attachment-check) + + (when jao-notmuch-enabled + (define-key message-mode-map (kbd "C-c C-d") #'notmuch-draft-postpone) + (setq message-directory "~/var/mail/" + message-auto-save-directory "/tmp" + mail-user-agent 'message-user-agent)) + + :bind (:map notmuch-common-keymap + (("E" . jao-notmuch-open-enclosure) + ("B" . notmuch-show-resend-message) + ("b" . jao-notmuch-browse-urls)))) + +(use-package jao-notmuch :demand t) + +;;; hello +(defun jao-notmuch-hello--header () (insert " ")) +(when (display-graphic-p) + (add-to-list 'notmuch-hello-sections 'jao-notmuch-hello--header)) + +(add-to-list 'notmuch-hello-sections 'notmuch-hello-insert-alltags t) + +(defun jao-notmuch-refresh-agenda () + (interactive) + (save-window-excursion (calendar) (jao-org-agenda))) + +(defun jao-notmuch-hello-first () + (interactive) + (let ((inhibit-message t)) + (goto-char (point-min)) + (widget-forward 1))) + +(defun jao-notmuch-refresh-hello (&optional agenda) + (interactive "P") + (ignore-errors + (when (and (string= "mail" (jao-afio-frame-name)) + (derived-mode-p 'notmuch-hello-mode)) + (when (not (string-blank-p jao-notmuch-minibuffer-string)) + (let ((notmuch-hello-auto-refresh nil)) (notmuch-hello))) + (let ((jao-minibuffer-inhibit t)) + (when agenda (jao-notmuch-refresh-agenda))) + (unless (widget-at) (jao-notmuch-hello-first)) + (jao-minibuffer-refresh)))) + +(defvar jao-notmuch-hello--sec-rx "^\\(\\[ [0-9]+\\|All tags:.+\\)") + +(defun jao-notmuch-hello-next-section () + (interactive) + (when (re-search-forward jao-notmuch-hello--sec-rx nil t) + (widget-forward 1))) + +(defun jao-notmuch-hello-prev-section () + (interactive) + (beginning-of-line) + (unless (looking-at-p jao-notmuch-hello--sec-rx) + (re-search-backward jao-notmuch-hello--sec-rx nil t)) + (when (re-search-backward jao-notmuch-hello--sec-rx nil t) + (end-of-line) + (widget-forward 1))) + +(defun jao-notmuch-hello-next () + (interactive) + (if (widget-at) + (widget-button-press (point)) + (jao-notmuch-hello-next-section))) + +(use-package notmuch-hello + :init + (setq notmuch-column-control 1.0 + notmuch-hello-hide-tags nil + notmuch-hello-thousands-separator "," + notmuch-hello-auto-refresh t + notmuch-show-all-tags-list nil + notmuch-show-logo nil + notmuch-show-empty-saved-searches nil) + + (add-to-list 'display-buffer-alist + '("\\*notmuch-hello\\*" + (display-buffer-reuse-window) + (body-function . (lambda (w) (set-window-margins w 1))))) + + :hook ((notmuch-hello-refresh . jao-notmuch-notify)) + + :config + (when jao-notmuch-enabled + (add-hook 'jao-afio-switch-hook #'jao-notmuch-refresh-hello)) + + :bind (:map notmuch-hello-mode-map + (("a" . jao-notmuch-refresh-agenda) + ("g" . jao-notmuch-refresh-hello) + ("j" . jao-notmuch-jump-search) + ("n" . jao-notmuch-hello-next) + ("p" . widget-backward) + ("SPC" . widget-button-press) + ("/" . consult-notmuch) + ("." . jao-notmuch-hello-first) + ("[" . jao-notmuch-hello-prev-section) + ("]" . jao-notmuch-hello-next-section)))) + +;;; show +(defun jao-notmuch-open-enclosure (add) + (interactive "P") + (with-current-notmuch-show-message + (goto-char (point-min)) + (if (not (search-forward "Enclosure:" nil t)) + (user-error "No enclosure in message body") + (re-search-forward "https?://" nil t) + (if-let (url (thing-at-point-url-at-point)) + (progn + (message "%s %s ..." (if add "Adding" "Playing") url) + (unless add (jao-mpc-clear)) + (jao-mpc-add-url url) + (unless add (jao-mpc-play))) + (error "Found an enclosure, but not a link!"))))) + +(defconst jao-mail-clean-rx + (regexp-opt '("ElDiario.es - ElDiario.es: " "The Guardian: " + "The Conversation – Articles (UK): " + "gr-qc updates on arXiv.org: " + "quant-ph updates on arXiv.org: "))) + +(defun jao-mail-clean-address (args) + (when-let ((address (car args))) + (list (thread-last (replace-regexp-in-string jao-mail-clean-rx "" address) + (replace-regexp-in-string " " ", "))))) + +(use-package notmuch-show + :init + (setq gnus-blocked-images "." + notmuch-message-headers + '("Subject" "To" "Cc" "Date" "Reply-To" "List-Id" "X-RSS-Feed") + notmuch-show-only-matching-messages t + notmuch-show-part-button-default-action 'notmuch-show-view-part + notmuch-wash-signature-lines-max 0 + notmuch-wash-wrap-lines-length 120 + notmuch-wash-citation-lines-prefix 120 + notmuch-wash-citation-lines-suffix 120 + notmuch-show-text/html-blocked-images "." + notmuch-show-header-line nil ;; #'jao-notmuch-message-header-line + jao-notmuch-header-line-format "[%N / %M / %T] %n / %m / %t") + + :config + + (advice-add 'notmuch-clean-address :filter-args #'jao-mail-clean-address) + (add-hook 'notmuch-show-mode-hook (lambda () (setq fill-column 80))) + + :bind + (:map notmuch-show-mode-map + (("h" . jao-notmuch-goto-tree-buffer) + ("r" . notmuch-show-reply) + ("R" . notmuch-show-reply-sender) + ("TAB" . jao-notmuch-show-next-button) + ([backtab] . jao-notmuch-show-previous-button) + ("RET" . jao-notmuch-show-ret)))) + +;;; search +(use-package notmuch-search + :init (setq notmuch-search-result-format + '(("date" . "%12s ") + ("count" . "%-7s ") + ("authors" . "%-35s") + ("subject" . " %-100s") + (jao-notmuch-format-tags . " (%s)")) + notmuch-search-buffer-name-format "*%s*" + notmuch-saved-search-buffer-name-format "*%s*") + :bind (:map notmuch-search-mode-map + (("RET" . notmuch-tree-from-search-thread) + ("M-RET" . notmuch-search-show-thread)))) + +;;; tree +(defun jao-notmuch-tree--forward (&optional prev) + (interactive) + (forward-line (if prev -1 1)) + (when prev (forward-char 2)) + (jao-notmuch-tree-scroll-or-next)) + +(defun jao-notmuch-tree--backward () + (interactive) + (jao-notmuch-tree--forward t)) + +(defun jao-notmuch--via-url () + (when (window-live-p notmuch-tree-message-window) + (with-selected-window notmuch-tree-message-window + (goto-char (point-min)) + (when (re-search-forward "^Via: http" nil t) + (thing-at-point-url-at-point))))) + +(defun jao-notmuch-browse-url (ext) + (interactive "P") + (when-let (url (or (jao-notmuch--via-url) + (car (last (jao-notmuch-message-urls))))) + (funcall (if ext browse-url-secondary-browser-function #'browse-url) + url))) + +(defun jao-notmuch-adjust-tree-fonts (&optional family) + (let ((fg (face-attribute 'jao-themes-dimm :foreground))) + (dolist (f '(notmuch-tree-match-tree-face + notmuch-tree-no-match-tree-face)) + (if family + (set-face-attribute f nil :family family :foreground fg) + (set-face-attribute f nil :foreground fg))))) + +(use-package notmuch-tree + :init + (setq notmuch-tree-result-format + `(("date" . "%12s ") + ("authors" . "%-25s") + ;; (jao-notmuch-format-author . 25) + (jao-notmuch-format-msg-ticks . ,jao-mails-regexp) + (jao-notmuch-format-tree-and-subject . "%>-85s") + (jao-notmuch-format-tags . " (%s)")) + notmuch-unthreaded-result-format notmuch-search-result-format + consult-notmuch-result-format + `((jao-notmuch-format-msg-ticks . ,jao-mails-regexp) + ("date" . "%12s ") + ("authors" . "%-35s") + ("subject" . " %-100s") + (jao-notmuch-format-tags . " (%s)")) + notmuch-tree-thread-symbols + '((prefix . "─") (top . "─") (top-tee . "┬") + (vertical . "│") (vertical-tee . "├") (bottom . "╰") + (arrow . "")) + ;; notmuch-tree-thread-symbols + ;; '((prefix . " ") (top . " ") (top-tee . " ") + ;; (vertical . " ") (vertical-tee . " ") (bottom . " ") + ;; (arrow . "")) + notmuch-tree-outline-enabled t + notmuch-tree-outline-visibility 'hide-others + notmuch-tree-outline-auto-close t + notmuch-tree-outline-open-on-next t) + :config + + (when (display-graphic-p) + (jao-notmuch-adjust-tree-fonts + (when (string-prefix-p "Hack" jao-themes-default-face) "Source Code Pro"))) + + (defun jao-notmuch-before-tree (&rest _args) + (when (string= (buffer-name) "*notmuch-hello*") + (window-configuration-to-register ?G) + (split-window-right 40) + (other-window 1))) + + (defvar jao-notmuch--visits 0) + + (defun jao-notmuch-after-tree-quit (&optional _both) + (when (not (derived-mode-p 'notmuch-tree-mode 'notmuch-hello-mode)) + (jump-to-register ?G)) + (jao-notmuch-refresh-hello (= 0 (mod (cl-incf jao-notmuch--visits) 50)))) + + (defun jao-notmuch-tree--sentinel (proc) + (when (eq (process-status proc) 'exit) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-max)) + (when (re-search-backward "^End of search results." nil t) + (delete-line)))) + (jao-notmuch-thread-info-mode))) + + (add-hook 'notmuch-tree-process-exit-functions #'jao-notmuch-tree--sentinel) + + (advice-add 'notmuch-tree :before #'jao-notmuch-before-tree) + (advice-add 'notmuch-tree-quit :after #'jao-notmuch-after-tree-quit) + + :bind (:map notmuch-tree-mode-map + (("b" . jao-notmuch-browse-urls) + ("d" . jao-notmuch-tree-toggle-delete) + ("D" . jao-notmuch-tree-toggle-delete-thread) + ("h" . jao-notmuch-goto-message-buffer) + ("i" . jao-notmuch-toggle-images) + ("k" . jao-notmuch-tree-read-thread) + ("N" . jao-notmuch-tree--forward) + ("O" . notmuch-tree-toggle-order) + ("o" . jao-notmuch-tree-widen-search) + ("P" . jao-notmuch-tree--backward) + ("r" . notmuch-tree-reply) + ("R" . notmuch-tree-reply-sender) + ("s" . jao-notmuch-tree-toggle-spam) + ("u" . jao-notmuch-tree-toggle-flag) + ("v" . notmuch-tree-scroll-message-window) + ("V" . notmuch-tree-scroll-message-window-back) + ("x" . jao-notmuch-arXiv-capture) + ("<" . jao-notmuch-tree-beginning-of-buffer) + (">" . jao-notmuch-tree-end-of-buffer) + ("\\" . notmuch-tree-view-raw-message) + ("." . jao-notmuch-toggle-mime-parts) + (";" . bbdb-mua-display-sender) + ("=" . jao-notmuch-tree-toggle-message) + ("RET" . jao-notmuch-tree-show-or-scroll) + ("SPC" . jao-notmuch-tree-scroll-or-next) + ("M-g" . jao-notmuch-browse-url) + ("M-u" . jao-notmuch-tree-reset-tags)))) + +;;; browse-url +(defvar jao-notmuch-url-rx "^notmuch:\\(/+\\|id:\\)\\(.+\\)") + +(defun jao-notmuch-open-url (url &rest _) + (and (string-match jao-notmuch-url-rx url) + (notmuch-show (concat "id:" (match-string 2 url))))) + +(add-to-list 'browse-url-handlers + (cons jao-notmuch-url-rx 'jao-notmuch-open-url)) + +;;; org mode +(defvar jao-org-notmuch-last-subject nil) +(defun jao-org-notmuch-last-subject () jao-org-notmuch-last-subject) + +(defun jao-notmuch--add-tags (tags) + (if (derived-mode-p 'notmuch-show-mode) + (notmuch-show-add-tag tags) + (notmuch-tree-add-tag tags))) + +(defun org-notmuch-store-link () + "Store a link to a notmuch mail message." + (cl-case major-mode + ((notmuch-show-mode notmuch-tree-mode) + ;; Store link to the current message + (let* ((id (notmuch-show-get-message-id)) + (link (concat "notmuch:" id)) + (subj (notmuch-show-get-subject)) + (description (format "Mail: %s" subj))) + (setq jao-org-notmuch-last-subject subj) + (when (y-or-n-p "Archive message? ") + (jao-notmuch--add-tags '("+trove"))) + (when (y-or-n-p "Flag message? ") + (jao-notmuch--add-tags '("+flagged"))) + (org-link-store-props :type "notmuch" + :link link + :description description))) + (notmuch-search-mode + ;; Store link to the thread on the current line + (let* ((id (notmuch-search-find-thread-id)) + (link (concat "notmuch:" id)) + (subj (notmuch-search-find-subject)) + (description (format "Mail: %s" subj))) + (setq jao-org-notmuch-last-subject subj) + (org-link-store-props + :type "notmuch" + :link link + :description description))))) + +(with-eval-after-load "org" + (org-link-set-parameters "notmuch" + :follow 'notmuch-show + :store 'org-notmuch-store-link)) +;;; arXiv +(use-package org-capture + :config + (when jao-notmuch-enabled + (add-to-list 'org-capture-templates + '("X" "arXiv" entry (file "notes/physics/arxiv.org") + "* %(jao-org-notmuch-last-subject)\n %i" + :immediate-finish t) + t) + (org-capture-upgrade-templates org-capture-templates))) + +(defun jao-notmuch-arXiv-capture () + (interactive) + (save-window-excursion + (jao-notmuch-goto-message-buffer) + (save-excursion + (goto-char (point-min)) + (re-search-forward "\\[ text/html \\]") + (forward-paragraph) + (setq-local transient-mark-mode 'lambda) + (set-mark (point)) + (goto-char (point-max)) + (org-capture nil "X")))) + +;;; html renderer +(when jao-notmuch-enabled (setq mm-text-html-renderer 'shr)) + +;;; consult +(jao-load-path "consult-notmuch") +(require 'consult-notmuch) +(setq consult-notmuch-newest-first t) +(consult-customize consult-notmuch :preview-key 'any) + +(defvar jao-consult-notmuch-history nil) + +(defvar jao-mailbox-folders '("bigml" "jao")) + +(defun jao-consult-notmuch-folder (&optional tree folder) + (interactive "P") + (let* ((folder (if folder + (file-name-as-directory folder) + (completing-read "Group: " + jao-mailbox-folders + nil nil nil + jao-consult-notmuch-history + "."))) + (folder (replace-regexp-in-string "/\\(.\\)" ".\\1" folder)) + (init (read-string "Initial query: ")) + (init (format "folder:/%s/ %s" folder init))) + (if tree (consult-notmuch-tree init) (consult-notmuch init)))) + +(with-eval-after-load "notmuch-hello" + (define-key notmuch-hello-mode-map "f" #'jao-consult-notmuch-folder)) +;;; recoll +(defun jao-notmuch-open-file (fname &optional _page) + (with-temp-buffer + (insert-file-contents-literally fname) + (goto-char (point-min)) + (and (re-search-forward "^Message-ID: <\\([^>]+\\)>$" nil t) + (notmuch-show (concat "id:" (match-string 1)))))) + +(when jao-notmuch-enabled + (with-eval-after-load "org" + (org-link-set-parameters "message" :follow #'jao-notmuch-open-file)) + + (with-eval-after-load "consult-recoll" + (add-to-list 'consult-recoll-open-fns + '("message/rfc822" . jao-notmuch-open-file)))) + +;;; . +(provide 'jao-custom-notmuch) diff --git a/custom/jao-custom-org.el b/custom/jao-custom-org.el new file mode 100644 index 0000000..4d2e622 --- /dev/null +++ b/custom/jao-custom-org.el @@ -0,0 +1,314 @@ +;; -*- lexical-binding: t -*- + +;;; General configuration +(defvar jao-org-dir (expand-file-name "~/doc/org")) + +(use-package org + :ensure t + :demand t + :custom ((org-export-backends '(ascii html latex texinfo))) + :init + (defalias 'jao-open-gnus-frame 'jao-afio-goto-mail) + + (setq org-adapt-indentation t + org-catch-invisible-edits 'smart + org-complete-tags-always-offer-all-agenda-tags t + org-cycle-separator-lines 0 ;; no blank lines when all colapsed + org-deadline-warning-days 14 + org-directory jao-org-dir + org-default-notes-file (expand-file-name "inbox.org" org-directory) + org-ellipsis " .." ;; ↴ + org-email-link-description-format "Email %c: %s" + org-enforce-todo-dependencies t + org-fast-tag-selection-single-key 'expert + org-insert-heading-respect-content nil ;; for C-RET + ;; org-list-demote-modify-bullet '(("+" . "-") ("-" . "+") ("*" . "+")) + org-link-frame-setup + '((gnus . (lambda (&optional x) (jao-open-gnus-frame))) + (file . find-file-other-window)) + org-log-done nil + org-modules '(bibtex info eww eshell git-link) + org-odd-levels-only t + org-outline-path-complete-in-steps nil + org-refile-allow-creating-parent-nodes 'confirm + org-refile-targets '((nil :maxlevel . 5) + (org-agenda-files :maxlevel . 5)) + org-refile-use-outline-path 'file + org-return-follows-link t + org-reverse-note-order t + org-special-ctrl-a/e t + org-src-fontify-natively t + org-startup-folded t + org-tag-alist nil + org-tags-column -75 + org-todo-keywords + '((sequence "TODO(t)" "STARTED(s!)" "|" "DONE(d!)") + (sequence "REPLY(r)" "WAITING(w!)" "|" "DONE(d!)") + (sequence "TOREAD(T)" "READING(R!)" "|" "READ(a!)") + (sequence "|" "CANCELLED(x!)" "SOMEDAY(o!)" "DONE(d!)")) + org-use-fast-todo-selection t + org-use-speed-commands nil ;; t and then ? to see help + org-gnus-prefer-web-links nil)) + +;;; Agenda +(setq org-agenda-custom-commands + '(("j" agenda "" ((org-agenda-ndays 14) + (org-agenda-overriding-header " "))) + ("w" todo "WAITING" nil) + ("W" agenda "" ((org-agenda-ndays 21)))) + org-agenda-files (mapcar (lambda (f) + (expand-file-name f jao-org-dir)) + '("inbox.org" "bigml.org")) + org-agenda-block-separator " " + org-agenda-breadcrumbs-separator "•" + org-agenda-current-time-string "•" ;; "*" + ;; '((daily today require-timed) + ;; (800 1000 1200 1400 1600 1800 2000) "" "·") + org-agenda-hide-tags-regexp ".*" + org-agenda-include-diary t + org-agenda-include-inactive-timestamps t + org-agenda-inhibit-startup nil + org-agenda-restore-windows-after-quit t + org-agenda-show-all-dates t + org-agenda-skip-deadline-if-done t + org-agenda-skip-scheduled-if-done nil + org-agenda-span 14 + org-agenda-start-on-weekday nil + org-agenda-time-grid '((daily require-timed) () "" "·") + org-agenda-window-setup 'current-window) + +(defun jao-org-agenda () + (interactive) + (org-agenda nil "j")) + +(defun jao-org-agenda-hook () + (setq-local cursor-in-non-selected-windows nil)) + +(add-hook 'org-agenda-mode-hook #'jao-org-agenda-hook) + +(add-to-list 'display-buffer-alist + '("\\*Org Agenda\\*" + (display-buffer-reuse-window) + (body-function . (lambda (w) (set-window-margins w 2 1))))) + + +;;; Capture templates +(setq org-capture-templates + '(("t" "TODO" entry + (file+headline "inbox.org" "Todo") + "* TODO %?\n %i%a" :prepend t) + ("r" "REPLY" entry + (file+headline "inbox.org" "Todo") + "* REPLY %:subject%?\n %t\n %i%a" :prepend t) + ("a" "Appointment" entry + (file+olp "inbox.org" "Appointments") + "* %^T %?\n %a" :time-prompt t) + ("i" "Inbox note" entry (file+headline "inbox.org" "Notes") + "* %a\n %i%?(added on: %u)" :prepend t))) +;; (org-capture-upgrade-templates org-capture-templates) + +;;; MIME and file apps +(setq org-file-apps + '((system . mailcap) + (".*\\.djvu" . system) + (t . emacs))) + +;;; Appearance +(use-package org-appear + :disabled t + :ensure t + :init (setq org-appear-autolinks nil + org-appear-delay 0.0 + org-appear-manual-linger t) + :hook (org-mode . org-appear-mode)) + +;;; Images +;; #+caption: Image caption. +;; #+attr_org: :width 100 +;; [[file:path/to/image.png]] + +(setq org-startup-indented nil + org-pretty-entities nil + org-hide-emphasis-markers t + org-hide-leading-stars t + org-startup-with-inline-images t + org-cycle-inline-images-display t + org-display-remote-inline-images 'download ;; 'skip 'cache + org-image-actual-width '(500)) + +;;; LaTeX +(use-package org-fragtog + :after org + :ensure t + :hook ((org-mode . org-fragtog-mode))) + +(require 'org-fragtog) + +(setq org-format-latex-options + `(:foreground default + :background + ,(if (jao-colors-scheme-dark-p) "black" "white") + :scale 1.25 + :html-foreground "black" + :html-background "Transparent" + :html-scale 1.0 + :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) + org-preview-latex-image-directory + (expand-file-name "~/.emacs.d/cache/ltximg/") + org-latex-hyperref-template nil + org-highlight-latex-and-related '(latex script entities)) + +(require 'ox-latex) + +;;; Export (minted and pandoc) +(setq org-latex-listings 'minted + org-latex-packages-alist '(("" "minted")) + org-latex-pdf-process + '("pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f" + "pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f")) + +;; (use-package ox-pandoc +;; :after org +;; :ensure t) + +;;; Babel and literate programming +(setq org-src-window-setup 'other-window) ;; current-window +(require 'org-tempo nil t) ;; <s TAB for 9.2 and later + +;; (use-package ob-prolog +;; :ensure t +;; :after org) + +(org-babel-do-load-languages + 'org-babel-load-languages + '((calc . t) + (clojure . t) + (emacs-lisp .t) + (gnuplot .t) + (haskell . t) + (makefile . t) + (ocaml . t) + (org . t) + (python . t) + (scheme .t) + (shell . t) + ;; (prolog . t) + )) + +;;; Org cliplink (link from clipboard) +(use-package org-cliplink + :ensure t + :bind (:map org-mode-map ("C-c C-f" . org-cliplink)) + :config + (add-to-list 'org-capture-templates + '("k" "Cliplink capture task" entry + (file+headline "inbox.org" "Todo") + "* TODO %(org-cliplink-capture) %?" :prepend t) + t)) + +;;; Notes +(use-package jao-org-notes + :commands (jao-org-notes-setup) + :config + (defun jao-org-notes-note-p () + (string-prefix-p jao-org-notes-dir (buffer-file-name))) + + (defun jao-org-notes-recoll () + "Use consult-recoll to search notes." + (interactive) + (consult-recoll (format "dir:%s " jao-org-notes-dir))) + + (jao-transient-major-mode org + ["Notes" + ("c" "open or create note" jao-org-notes-create) + ("/" "find and open note" jao-org-notes-open) + ("\\" "find and open note by tags" jao-org-notes-consult-tags)] + ["Extended search" + ("g" "ripgrep notes" jao-org-notes-consult-ripgrep) + ("r" "recoll notes" jao-org-notes-recoll)] + ["Current note" :if jao-org-notes-note-p + ("i" "insert link" jao-org-notes-insert-link) + ("t" "insert tags" jao-org-notes-insert-tags) + ("v" "show backlinks" jao-org-notes-backlinks)])) + +(jao-org-notes-setup "n") + +;;; Links +(require 'ol-eshell nil t) +;; (require 'ol-bbdb nil t) +(require 'ol-info nil t) +(setq org-link-abbrev-alist '(("jao.io" "https://jao.io/"))) + +(defun jao-org-link-at-point (&optional copy) + (when (thing-at-point-looking-at "\\[\\[\\([^]]+\\)\\]\\[[^]]+\\]\\]") + (when copy (kill-ring-save (match-beginning 1) (match-end 1))) + (match-string-no-properties 1))) + +(defun jao-org-copy-link-at-point () + (interactive) + (message "%s" (or (jao-org-link-at-point t) "No link at point"))) + +(defun jao-org-insert-link (url title) + (insert (format "[[%s][%s]]" url title))) + +(defun jao-insert-eww-link () + "Look for last eww buffer and insert an org link to it." + (interactive) + (when-let (b (car (jao-eww-session-eww-buffers))) + (let ((lnk (with-current-buffer b + (format "[[%s][%s]]" + (eww-current-url) + (jao-eww-buffer-title))))) + (insert lnk)))) + +(use-package jao-org-links + :commands jao-org-links-setup + :bind (("C-c T" . jao-org-insert-doc))) + +(jao-org-links-setup jao-sink-dir) + +(with-eval-after-load "pdf-view" + (define-key pdf-view-mode-map (kbd "C-c o") #'jao-org-pdf-goto-org) + (define-key pdf-view-mode-map (kbd "C-c O") #'jao-org-pdf-goto-org*)) + +(with-eval-after-load "doc-view" + (define-key doc-view-mode-map (kbd "C-c o") #'jao-org-pdf-goto-org) + (define-key doc-view-mode-map (kbd "C-c O") #'jao-org-pdf-goto-org*)) + +;; eldoc +(defun jao-org-eldoc--hook () + (set (make-local-variable 'eldoc-documentation-function) + 'jao-org-link-at-point) + (eldoc-mode)) +(add-hook 'org-mode-hook 'jao-org-eldoc--hook) + +;;; savedoc +(defun jao-org--show-if-hidden () + (when (outline-invisible-p) + (save-excursion + (outline-previous-visible-heading 1) + (org-show-subtree)))) +(add-hook 'org-mode-hook 'jao-org--show-if-hidden t) + +;;; Keybindings +(define-key mode-specific-map [?a] 'org-agenda) +(define-key org-mode-map "\C-cv" 'jao-org-copy-link-at-point) +(define-key org-mode-map [(control ?c) tab] 'org-force-cycle-archived) +(define-key org-mode-map [(f7)] 'org-archive-to-archive-sibling) +(define-key org-mode-map "\C-cE" 'jao-insert-eww-link) +(define-key org-mode-map "\C-cW" 'jao-insert-eww-link) +(define-key org-mode-map "\C-c'" 'org-edit-src-code) +(define-key org-mode-map "\C-cO" 'outline-hide-other) +(global-set-key "\C-cr" 'org-capture) +(global-set-key "\C-c\C-l" 'org-store-link) +;; (global-set-key "\C-cL" 'org-insert-link-global) +(global-set-key "\C-cO" 'org-open-at-point-global) + +(jao-transient-major-mode+ org + ["Links" + ("le" "insert current eww link" jao-insert-eww-link) + ("lf" "insert link from clipboard" org-cliplink) + ("lc" "copy link at point" jao-org-copy-link-at-point)]) + +;;; . +(provide 'jao-custom-org) diff --git a/custom/jao-custom-w3m.el b/custom/jao-custom-w3m.el new file mode 100644 index 0000000..43b9e2d --- /dev/null +++ b/custom/jao-custom-w3m.el @@ -0,0 +1,211 @@ +;; -*- lexical-binding: t -*- + +;;; browse-url and afio +(defun jao-w3m-find-url (url) + (let* ((url (w3m-canonicalize-url url)) + (fn `(lambda (b) + (with-current-buffer b + (string= ,url (w3m-canonicalize-url w3m-current-url)))))) + (when-let (b (seq-find fn (w3m-list-buffers))) + (pop-to-buffer b)))) + +(defun jao-w3m-browse-url (url &rest r) + (jao-afio-goto-www) + (select-window (frame-first-window)) + (unless (jao-w3m-find-url url) + (w3m-goto-url-new-session url))) + +(defun jao-w3m-download (arg) + (interactive "P") + (jao-download (w3m-anchor) arg)) + +(setq jao-afio-use-w3m t) +(setq jao-browse-url-function 'jao-w3m-browse-url) + +;;; multipart html renderer +(defun jao-w3m-html-renderer (handle) + (let ((w3m-message-silent t) + (w3m-fill-column 120) + (mm-w3m-safe-url-regexp nil) + (mm-inline-text-html-with-w3m-keymap t)) + (condition-case e + (mm-inline-text-html-render-with-w3m handle) + (error (message "Error rendering page with w3m: %s" e) + (delete-region (point) (point-max)) + (let ((shr-use-fonts nil)) + (mm-shr handle)))))) + +(setq mm-text-html-renderer 'jao-w3m-html-renderer) + +;;; notmuch integration +(defvar-local jao-notmuch--showing-images nil) + +(defun jao-notmuch--setup-w3m-images (&optional activate) + (setq-local w3m-ignored-image-url-regexp + (unless jao-notmuch--showing-images + notmuch-show-text/html-blocked-images)) + (when activate + (setq-local scroll-margin 0) + (w3m-toggle-inline-images (if jao-notmuch--showing-images t 'turnoff)))) + +(defun jao-notmuch--w3m-toggle-images () + (save-window-excursion + (when (or (derived-mode-p 'notmuch-show-mode) + (jao-notmuch-goto-message-buffer nil t)) + (goto-char (point-min)) + (when (re-search-forward "^\\[ text/html " nil t) + (when (looking-at-p "(hidden)") + (notmuch-show-toggle-part-invisibility)) + (forward-line 1) + (setq jao-notmuch--showing-images (not jao-notmuch--showing-images)) + (jao-notmuch--setup-w3m-images t))))) + +(add-hook 'notmuch-show-mode-hook #'jao-notmuch--setup-w3m-images) + +;;; org integration +(defun jao-w3m-get-link () + (let ((wb (w3m-alive-p))) + (when wb + (let ((url (with-current-buffer wb w3m-current-url)) + (title (w3m-buffer-title wb))) + (cons url title))))) + +(defun jao-insert-w3m-link () + (interactive) + (let ((link (jao-w3m-get-link))) + (when link (insert "[[" (car link) "][" (cdr link) "]]")))) + +(with-eval-after-load "org" + (require 'ol-w3m nil t) + (define-key org-mode-map "\C-cW" 'jao-insert-w3m-link)) + +;;; capture page +(defun jao-w3m-capture-page () + (interactive) + (let* ((title (w3m-current-title)) + (url w3m-current-url) + (html (y-or-n-p "Save as HTML (y) or PS (n)? ")) + (basename (concat (read-string "File name: ") + (if html ".html" ".ps"))) + (name (expand-file-name basename jao-sink-dir))) + (if html + (progn + (w3m-view-source) + (write-region (point-min) (point-max) name nil nil nil t) + (w3m-view-source)) + (progn + (split-window-horizontally 85) + (w3m-redisplay-this-page) + (ps-print-buffer name) + (delete-other-windows) + (w3m-redisplay-this-page))) + (kill-new (format "[[doc:%s][%s]] ([[%s][original]])" + basename title url)))) + +;;; consult narrowing +(with-eval-after-load "w3m-util" + (with-eval-after-load "consult" + (defvar jao-consult-w3m-buffer-history nil) + (defun jao-www--item (b) + (with-current-buffer b + (propertize (or w3m-current-title (buffer-name)) + 'buffer b + 'url (or w3m-current-url (buffer-name))))) + (defvar jao-consult-w3m-source + (list :name "www buffer" + :category 'www-buffer + :hidden t + :narrow (cons ?w "www") + :annotate (lambda (b) (when b (get-text-property 0 'url b))) + :history 'jao-consult-w3m-buffer-history + :items (lambda () + (seq-map #'jao-www--item + (seq-filter #'jao-www--buffer-p (buffer-list)))) + :action (lambda (b) + (jao-afio-goto-www) + (switch-to-buffer (get-text-property 0 'buffer b))))) + (jao-consult-add-buffer-source 'jao-consult-w3m-source))) + +;;; package +(use-package w3m + :ensure t + :demand t + :custom ((w3m-key-binding 'info) + (w3m-display-mode 'dual-pane)) + :init + (setq w3m-add-user-agent nil + w3m-confirm-leaving-secure-page nil + w3m-cookie-accept-bad-cookies t + w3m-cookie-accept-domains '(".github.com" + ".librarything.com" + ".goodreads.com" + ".sr.ht" + ".gnu.org" + ".codeberg.org" + "codeberg.org" + ".bookshop.org" + ".reddit.com") + w3m-cookie-reject-domains '(".") + w3m-default-display-inline-images nil + w3m-default-save-directory "~/doc/sink" + w3m-do-cleanup-temp-files nil + w3m-external-view-temp-directory "/tmp" + w3m-fill-column 110 + w3m-goto-article-function 'jao-w3m-browse-url + w3m-form-input-textarea-buffer-lines 40 + w3m-history-minimize-in-new-session t + w3m-history-reuse-history-elements nil + w3m-init-file nil + w3m-image-no-idle-timer t + w3m-make-new-session t + w3m-profile-directory "~/.w3m" + w3m-redisplay-pages-automatically-p nil + w3m-resize-images t + w3m-safe-url-regexp nil + w3m-search-default-engine "duckduckgo" ; "google-en" + w3m-select-buffer-horizontal-window nil + w3m-select-buffer-window-ratio '(20 . 40) + w3m-session-load-last-sessions t + w3m-session-load-crashed-sessions 'ask + w3m-show-graphic-icons-in-header-line nil + w3m-show-graphic-icons-in-mode-line nil + w3m-toggle-inline-images-permanently nil + w3m-use-tab nil + w3m-use-tab-line nil + w3m-use-title-buffer-name t + w3m-use-cookies t + w3m-use-filter nil + w3m-use-favicon nil + w3m-use-header-line nil + w3m-use-refresh nil + w3m-use-symbol t) + + :config + :bind (:map w3m-mode-map + (("+" . w3m-zoom-in-image) + ("-" . w3m-zoom-out-image) + ("C-c C-@" . tracking-next-buffer) + ("C-c C-SPC" . tracking-next-buffer) + ("C-c C-b" . nil) + ("C-l" . nil) + ("C-c c" . jao-w3m-capture-page) + ("b" . w3m-view-previous-page) + ("B" . w3m-view-next-page) + ("c" . w3m-print-this-url) + ("d" . jao-w3m-download) + ("D" . w3m-download) + ("f" . w3m-lnum-follow) + ("v" . jao-view-video) + ("q" . w3m-delete-buffer) + ("w" . org-w3m-copy-for-org-mode) + ("x" . jao-rss-subscribe) + ("y" . w3m-print-current-url)))) + +;;; textsec +;; the way in which w3m constructs ALT text for links to images confuses +;; makes it suspicious under textsec link check. +(with-eval-after-load "textsec" + (advice-add 'textsec-link-suspicious-p :override #'ignore)) + +;;; . +(provide 'jao-custom-w3m) diff --git a/data/commons.html b/data/commons.html new file mode 100644 index 0000000..35500b5 --- /dev/null +++ b/data/commons.html @@ -0,0 +1,15 @@ +<center> + <a rel="license" href="https://creativecommons.org/licenses/by-sa/3.0/"> + <img alt="Creative Commons License" style="border-width:0" + src="https://i.creativecommons.org/l/by-sa/3.0/88x31.png" /> + </a> + <br /> + <span xmlns:dct="https://purl.org/dc/terms/" + href="https://purl.org/dc/dcmitype/Text" property="dct:title" + rel="dct:type">jao.io</span> by + <a xmlns:cc="https://creativecommons.org/ns#" href="https://jao.io" + property="cc:attributionName" rel="cc:attributionURL">jao</a> + is licensed under a + <a rel="license" href="https://creativecommons.org/licenses/by-sa/3.0/"> + Creative Commons Attribution-ShareAlike 3.0 Unported License</a>. +</center> diff --git a/data/foot.ini b/data/foot.ini new file mode 100644 index 0000000..7063716 --- /dev/null +++ b/data/foot.ini @@ -0,0 +1,63 @@ +# -*- conf -*- + +font=DejaVu Sans Mono:size=9, Noto Color Emoji:size=9 +font-bold=DejaVu Sans Mono:size=9:weight=semibold + +# font=Iosevka Comfy Fixed:size=6 +# font-bold=Iosevka Comfy Motion:size=6:weight=bold + +underline-offset=10 +pad=5x2 center + +# initial-window-size-pixels=700x500 # Or, +# initial-window-size-chars=<COLSxROWS> +# initial-window-mode=windowed +# shell=$SHELL (if set, otherwise user's default shell from /etc/passwd) +# term=foot +# login-shell=no +# workers=<number of logical CPUs> + +[scrollback] +# lines=1000 +# multiplier=3.0 +# indicator-position=relative +# indicator-format= + +[cursor] +style=block +color=ffffff b22222 +blink=no + +[bell] +notify=no +urgent=yes +command="notify-send ping!" + +[mouse] +hide-when-typing=yes +# alternate-scroll-mode=yes + +[colors] +alpha=0.85 +background=ffffff +foreground=000000 + +regular0= 073642 +regular1= dc322f +regular2= 859900 +regular3= b58900 +regular4= 268bd2 +regular5= d33682 +regular6= 2aa198 +regular7= eee8d5 +bright0= 002b36 +bright1= cb4b16 +bright2= 586e75 +bright3= 657b83 +bright4= 839496 +bright5= 6c71c4 +bright6= 93a1a1 +bright7= fdf6e3 + +# selection-foreground=<inverse foreground/background> +# selection-background=<inverse foreground/background> diff --git a/data/kitty.conf b/data/kitty.conf new file mode 100644 index 0000000..efe2477 --- /dev/null +++ b/data/kitty.conf @@ -0,0 +1,91 @@ +font_size 9.0 +# font_family Fira Code +# bold_font Fira Code SemiBold +# italic_font Fira Code Italic + +font_family DejaVu Sans + +disable_ligatures always +box_drawing_scale 0.1, 0.5, 1, 1 + +cursor orangered2 +cursor_text_color #111111 +cursor_shape block +cursor_blink_interval 0 +cursor_stop_blinking_after 15.0 + +# scrollback_lines 2000 +scrollback_lines 0 +scrollback_pager less +G -R +wheel_scroll_multiplier 5.0 + +url_color #0087BD +url_style curl +detect_urls no + +copy_on_select yes + +select_by_word_characters :@-./_~?&=%+# + +click_interval 0.5 +mouse_hide_wait 1.0 + +focus_follows_mouse no + +input_delay 3 +sync_to_monitor yes + +visual_bell_duration 0.2 +window_alert_on_bell yes +enable_audio_bell no + +remember_window_size yes +initial_window_width 640 +initial_window_height 400 + +enabled_layouts * +window_border_width 1 +window_margin_width 1 +window_padding_width 0 +active_border_color #00ff00 +inactive_border_color #cccccc +inactive_text_alpha 1.0 + +foreground #000000 +background #ffffff +background_opacity 0.9 + +selection_background #efebe7 +selection_foreground #101010 + +# black +color0 #000000 +color8 #000000 +# red +color1 OrangeRed1 +color9 OrangeRed2 +# green +color2 DarkSeaGreen4 +color10 DarkSeaGreen3 +# yellow +color3 lightgoldenrod3 +color11 lightyellow4 +# blue +color4 steelblue4 +color12 steelblue3 +# magenta +color5 lightpink2 +color13 lightpink3 +# cyan +color6 cyan4 +color14 cyan4 +# white +color7 #ffffff +color15 #ffffff + +map ctrl+enter send_text all \x1b[27;5;13~ +map ctrl+. send_text all \x1b[27;5;46~ +map ctrl+; send_text all \x1b[27;5;59~ +map ctrl+' send_text all \x1b[27;5;39~ +map ctrl+( send_text all \x1b[27;5;40~ +map ctrl+) send_text all \x1b[27;5;41~ diff --git a/email.org b/email.org deleted file mode 100644 index 7004730..0000000 --- a/email.org +++ /dev/null @@ -1,369 +0,0 @@ -#+property: header-args:emacs-lisp :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" :tangle-mode (identity #o644) -#+title: email handling (message mode, bbdb, gnus, notmuch) - -* personal emails and others - #+begin_src emacs-lisp - (defvar jao-mails) - (defvar jao-extra-mails) - (defvar jao-mails-regexp (regexp-opt jao-mails)) - (defvar jao-notmuch-enabled (eq jao-afio-mail-function 'notmuch)) - #+end_src -* gnus - #+begin_src emacs-lisp - (setq gnus-init-file "~/.emacs.d/gnus.el" - gnus-home-directory "~/.emacs.d/gnus" - gnus-directory gnus-home-directory - gnus-cache-directory (expand-file-name "cache" gnus-home-directory) - gnus-kill-files-directory (expand-file-name "News" gnus-home-directory) - message-directory (expand-file-name "Mail" gnus-home-directory) - mail-source-directory (expand-file-name "Mail" gnus-home-directory)) - - (let ((org-file (expand-file-name "gnus.org" jao-emacs-dir))) - (when (file-newer-than-file-p org-file gnus-init-file) - (org-babel-tangle-file org-file))) - - #+end_src -* message mode -*** Customization - #+begin_src emacs-lisp - (setq message-send-mail-function 'message-send-mail-with-sendmail - message-sendmail-envelope-from 'header - message-sendmail-f-is-evil nil) - (setq imap-store-password t) - (setq password-cache-expiry nil) - (setq message-generate-headers-first t) - (setq message-forward-before-signature nil) - (setq message-alternative-emails - (regexp-opt (append jao-mails jao-extra-mails))) - (setq message-dont-reply-to-names - (regexp-opt (append jao-mails '("noreply@" "@noreply" - "no-reply@" "@no-reply" - "notifications@github")))) - (setq message-citation-line-format "On %a, %b %d %Y, %N wrote:\n") - (setq message-citation-line-function 'message-insert-formatted-citation-line) - - (setq message-user-fqdn "gnus.jao.io") - - ;; writing messages - (setq message-kill-buffer-on-exit t) - (setq message-max-buffers 5) - (setq message-insert-signature t) - (setq message-from-style 'angles - user-mail-address (car jao-mails) - mail-host-address system-name - message-syntax-checks '((sender . disabled)) - message-default-headers - (concat - "X-Attribution: jao\n" - "X-Clacks-Overhead: GNU Terry Pratchett\n" - "X-URL: <https://jao.io/>\n") - message-hidden-headers - '("^References:" "^Face:" "^X-Face:" "^X-Draft-From:") - message-make-forward-subject-function 'message-forward-subject-fwd) - - (setq message-expand-name-standard-ui t) - #+end_src -*** To->From and Bcc - #+begin_src emacs-lisp - (defvar jao-message--bcc-rx (regexp-opt '("mail.io" "gnu.org"))) - - (defun jao-message-insert-bcc () - (let ((f (or (message-fetch-field "From") ""))) - (when (or (string-blank-p f) (string-match-p jao-message--bcc-rx f)) - (insert "Bcc: proton@jao.io\n")))) - - (add-hook 'message-header-setup-hook #'jao-message-insert-bcc) - - (defvar jao-message-to-from nil) - - (defun jao-message-adjust-from () - (let ((to (concat (message-fetch-field "To") (message-fetch-field "Cc")))) - (when-let* ((tf (seq-find (lambda (tf) (string-match-p (car tf) to)) - jao-message-to-from)) - (from (message-make-from "Jose A Ortega Ruiz" (cdr tf)))) - (save-restriction - (widen) - (message-replace-header "From" from))))) - - (add-hook 'message-header-setup-hook #'jao-message-adjust-from) - - #+end_src -*** Encryption - #+begin_src emacs-lisp - ;; avoiding bogus warning - (setq gnutls-min-prime-bits nil) - (setq gnus-buttonized-mime-types - '("multipart/encrypted" "multipart/signed" "multipart/alternative")) - - (setq mm-verify-option 'always) - (setq mm-decrypt-option 'always) - - (setq mm-sign-option 'guided) - (setq mm-encrypt-option 'guided) - - (setq mml-secure-passphrase-cache-expiry (* 3600 24) - password-cache-expiry (* 3600 24)) - - (setq smime-CA-directory "/etc/ssl/certs/" - smime-certificate-directory - (expand-file-name "certs/" gnus-directory)) - - (with-eval-after-load "mm-decode" - ;; Tells Gnus to inline the part - (add-to-list 'mm-inlined-types "application/pgp$") - ;; Tells Gnus how to display the part when it is requested - (add-to-list 'mm-inline-media-tests '("application/pgp$" - mm-inline-text identity)) - ;; Tell Gnus not to wait for a request, just display the thing - ;; straight away. - (add-to-list 'mm-automatic-display "application/pgp$") - ;; But don't display the signatures, please. - (setq mm-automatic-display (remove "application/pgp-signature" - mm-automatic-display))) - - ;; decide whether to encrypt or just sign outgoing messages - (defvar jao-message-try-sign nil) - (defun jao-message-maybe-sign () - (when (and jao-message-try-sign (y-or-n-p "Sign message? ")) - (if (y-or-n-p "Encrypt message? ") - (let ((recipient (message-fetch-field "To"))) - (if (or (pgg-lookup-key recipient) - (and (y-or-n-p (format "Fetch %s's key? " recipient)) - (pgg-fetch-key pgg-default-keyserver-address - recipient))) - (mml-secure-message-encrypt-pgp) - (mml-secure-message-sign-pgp))) - (mml-secure-message-sign-pgp)))) - - ;; for ma gnus - (eval-after-load "rfc2047" - '(add-to-list 'rfc2047-header-encoding-alist - '("User-Agent" . address-mime))) - #+end_src -*** Attach image to message - Use ~C-c C-p~ in message-mode, and ~C-c y~. -*** Check attachment - #+begin_src emacs-lisp - (defvar jao-message-attachment-regexp "\\([Ww]e send\\|[Ii] send\\|attach\\)") - (defun jao-message-check-attachment () - "Check if there is an attachment in the message if I claim it." - (save-excursion - (message-goto-body) - (when (search-forward-regexp jao-message-attachment-regexp nil t nil) - (message-goto-body) - (unless (or (search-forward "<#part" nil t nil) - (message-y-or-n-p - "No attachment. Send the message? " nil nil)) - (error "No message sent"))))) - #+end_src -*** Check Fcc/Gcc - #+begin_src emacs-lisp - (defun jao-message-check-gcc () - "Ask whether to keep a copy of message." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (when (and (or (message-fetch-field "Gcc") - (message-fetch-field "Fcc")) - (not (y-or-n-p "Archive? "))) - (message-remove-header "\\(?:[BFG]cc\\)"))))) - #+end_src -*** Check recipient - #+begin_src emacs-lisp - (defun jao-message-check-recipient () - (save-excursion - (save-restriction - (message-narrow-to-headers) - (when-let ((to (message-fetch-field "To"))) - (when (string-match-p jao-mails-regexp to) - (unless (y-or-n-p "Message is addressed to yourself. Continue?") - (error "Message not sent"))))))) - #+end_src -*** Randomsig - #+begin_src emacs-lisp - (with-eval-after-load "message" - (when (require 'randomsig nil t) - (define-key message-mode-map (kbd "C-c s") 'randomsig-replace-sig) - (define-key message-mode-map (kbd "C-c S") 'randomsig-select-sig) - (setq randomsig-dir (expand-file-name "~/etc/config/emacs")) - (setq randomsig-files '("signatures.txt")) - ;; or (setq randomsig-files (randomsig-search-sigfiles)) - ;; or (setq randomsig-files 'randomsig-search-sigfiles) - (setq message-signature 'randomsig-signature) - (setq randomsig-delimiter-pattern "^%$" - randomsig-delimiter "%"))) - #+end_src -*** Send mail hooks - #+begin_src emacs-lisp - (dolist (h '(jao-message-check-gcc - jao-message-check-recipient - jao-message-maybe-sign)) - (add-hook 'message-send-hook h)) - (unless jao-notmuch-enabled - (add-hook 'message-send-hook #'jao-message-check-attachment)) - #+end_src -*** Keybindings - #+begin_src emacs-lisp - (with-eval-after-load "message" - ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp) - (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp) - (define-key message-mode-map (kbd "C-c y") #'yank-media)) - #+end_src -* sendmail/smtp - #+begin_src emacs-lisp - (defun jao-sendmail-gmail () - (setq smtpmail-auth-supported '(login cram-md5 plain)) - (setq smtpmail-smtp-server "smtp.gmail.com") - (setq smtpmail-smtp-service 587)) - - (defun jao-sendmail-local () - (setq send-mail-function 'sendmail-send-it) - (setq smtpmail-auth-supported nil) ;; (cram-md5 plain login) - (setq smtpmail-smtp-server "127.0.0.1") - (setq smtpmail-smtp-service 25)) - - (defun jao-sendmail-msmtp () - (setq send-mail-function 'sendmail-send-it - sendmail-program "/usr/bin/msmtp" - mail-specify-envelope-from t - message-sendmail-envelope-from 'header - mail-envelope-from 'header)) - - (jao-sendmail-local) - #+end_src -* mailcap - #+begin_src emacs-lisp - (use-package mailcap - :config - (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg")) - (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg")) - - (defun jao-icalendar-import-buffer () - (let ((icalendar-import-format "%s%u%l%d")) - (icalendar-import-buffer diary-file t nil)) - (kill-buffer) - (message "Event imported into diary")) - - :custom - ((mailcap-user-mime-data - '((jao-icalendar-import-buffer "application/ics") - ("viewpdf.sh %s" "application/pdf"))))) - #+end_src -* multipart html renderer - #+begin_src emacs-lisp - (defun jao-w3m-html-renderer (handle) - (let ((w3m-message-silent t) - (mm-w3m-safe-url-regexp nil)) - (condition-case nil - (mm-inline-text-html-render-with-w3m handle) - (error (delete-region (point) (point-max)) - (let ((shr-use-fonts nil) - (shr-use-colors nil)) - (mm-shr handle)))))) - - (defun jao-shr-html-renderer (handle) - (let (;; (shr-use-fonts t) - ;; (shr-use-colors t) - (shr-width 130)) - (mm-shr handle))) - - ;; (setq mm-text-html-renderer #'jao-w3m-html-renderer) - (setq mm-text-html-renderer #'jao-shr-html-renderer) - #+end_src -* bbdb - #+begin_src emacs-lisp - (use-package bbdb - :ensure t - :init (setq bbdb-complete-name-allow-cycling t - bbdb-completion-display-record nil - bbdb-gui t - bbdb-message-all-addresses t - bbdb-complete-mail-allow-cycling t - bbdb-north-american-phone-numbers-p nil - bbdb-add-aka t - bbdb-add-name 2 - bbdb-message-all-addresses t - bbdb-mua-pop-up t ;; 'horiz - bbdb-mua-pop-up-window-size 0.3 - bbdb-layout 'multi-line - bbdb-mua-update-interactive-p '(query . create) - bbdb-mua-auto-update-p 'bbdb-select-message - bbdb-user-mail-address-re jao-mails-regexp - bbdb-auto-notes-ignore-headers - `(("From" . ,jao-mails-regexp) - ("From" . ".*@.*github\.com.*") - ("To" . ".*@.*github\.com.*") - ("Reply-to" . ".*") - ("References" . ".*")) - bbdb-auto-notes-ignore-messages - `(("To" . ".*@.*github\\.com.*") - ("From" . ".*@.*github\\.com.*") - ("From" . "info-list") - ("From" . "no-?reply\\|deploy") - ("X-Mailer" . "MailChimp")) - bbdb-accept-message-alist - `(("To" . ,jao-mails-regexp) - ("Cc" . ,jao-mails-regexp) - ("BCc" . ,jao-mails-regexp)) - bbdb-ignore-message-alist bbdb-auto-notes-ignore-messages) - :config - (add-hook 'message-setup-hook 'bbdb-mail-aliases) - ;; (add-hook 'bbdb-notice-mail-hook 'bbdb-auto-notes) - (add-hook 'bbdb-after-change-hook (lambda (arg) (bbdb-save))) - (require 'bbdb-anniv) ;; BBDB 3.x this gets birthdays in org agenda - ;; and diary - clever stuff - (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries) - - (setq bbdb-file (expand-file-name "~/.emacs.d/bbdb")) - (if jao-notmuch-enabled - (bbdb-initialize 'message 'pgp) - (bbdb-initialize 'message 'pgp 'gnus))) - #+end_src -* mailboxes - #+begin_src emacs-lisp - (defun jao-list-mailboxes (base &rest excl) - (let ((dir (expand-file-name base "~/var/mail"))) - (seq-difference (directory-files dir) (append '("." "..") excl)))) - - - #+end_src -* consult narrowing - #+begin_src emacs-lisp - (defvar jao-mail-consult-buffer-history nil) - - (defun jao-mail-buffer-p (b) - (or (member (buffer-name b) - '("*Calendar*" "inbox.org" "*Org Agenda*" - "*Fancy Diary Entries*" "diary")) - (with-current-buffer b - (derived-mode-p 'notmuch-show-mode - 'notmuch-search-mode - 'notmuch-tree-mode - 'notmuch-hello-mode - 'notmuch-message-mode - 'gnus-group-mode - 'gnus-summary-mode - 'gnus-article-mode)))) - - (defvar jao-mail-consult-source - (list :name "mail buffer" - :category 'buffer - :hidden t - :narrow (cons ?n "mail buffer") - :history 'jao-mail-consult-buffer-history - :action (lambda (b) - (when (not (string-blank-p (or b ""))) - (jao-afio--goto-mail) - (if (get-buffer-window b) - (pop-to-buffer b) - (pop-to-buffer-same-window b)))) - :items (lambda () - (mapcar #'buffer-name - (seq-filter #'jao-mail-buffer-p (buffer-list)))))) - - (jao-consult-add-buffer-source 'jao-mail-consult-source "Mail" ?n) - #+end_src -* notmuch - #+begin_src emacs-lisp - (jao-load-org "notmuch") - #+end_src diff --git a/eww.org b/eww.org deleted file mode 100644 index 4a9dd71..0000000 --- a/eww.org +++ /dev/null @@ -1,191 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t -*-" :tangle-mode (identity #o644) -#+title: Web browsing using eww - -* Integration with browse-url and afio - #+begin_src emacs-lisp - (defun jao-eww-browse-url (url &rest r) - "Browse URL using eww." - (if (derived-mode-p 'eww-mode) - (eww url) - (jao-afio--goto-www) - (select-window (frame-first-window)) - (let* ((url (url-encode-url url)) - (bf (seq-find `(lambda (b) - (with-current-buffer b - (string= ,url - (url-encode-url (eww-current-url))))) - (jao-eww-session--list-buffers)))) - (cond (bf (switch-to-buffer bf)) - ((string-match-p url "^file://") (eww-open-file url)) - (t (eww url 4)))))) - - (setq jao-browse-url-function #'jao-eww-browse-url) - (setq eww-use-browse-url "^\\(gemini\\|gopher\\):") - #+end_src -* Opening URLs - #+begin_src emacs-lisp - (defun jao-eww-copy-link () - (interactive) - (when-let (lnk (or (car (eww-links-at-point)) (eww-current-url))) - (message "%s" lnk) - (kill-new lnk))) - - (defun jao-eww-browse (arg) - (interactive "P" eww-mode) - (setq eww-prompt-history - (cl-remove-duplicates eww-prompt-history :test #'string=)) - (let ((url (completing-read (if arg "eww in new buffer: " "eww: ") - eww-prompt-history nil nil nil - 'eww-prompt-history (eww-current-url)))) - (eww url (when arg 4)))) - - (defun jao-eww-browse-new () - (interactive nil eww-mode) - (jao-eww-browse t)) - - (defun jao-eww-reload (images) - (interactive "P" eww-mode) - (if images - (let ((shr-blocked-images nil)) - (eww-reload t)) - (call-interactively 'eww-reload))) - #+end_src -* Consult narrowing - #+begin_src emacs-lisp - (with-eval-after-load "consult" - (defvar jao-eww-consult-history nil) - (defvar jao-eww-buffer-source - (list :name "eww buffer" - :category 'eww-buffer - :hidden t - :narrow (cons ?e "eww") - :annotate (lambda (c) (get-text-property 0 'url c)) - :history 'jao-eww-consult-history - :action (lambda (b) - (jao-afio--goto-www) - (switch-to-buffer (get-text-property 0 'buffer b))) - :items - (lambda () - (seq-map (lambda (b) - (with-current-buffer b - (let ((tl (or (plist-get eww-data :title) "")) - (url (or (eww-current-url) (buffer-name)))) - (propertize (if (string-blank-p tl) url tl) - 'buffer b 'url url)))) - (seq-filter #'jao-www--buffer-p (buffer-list)))))) - (jao-consult-add-buffer-source 'jao-eww-buffer-source "Web" ?e)) - #+end_src -* Images - #+begin_src emacs-lisp - (defun jao-eww-next-image () - (interactive nil eww-mode) - (when-let (p (text-property-search-forward 'image-displayer nil nil t)) - (goto-char (prop-match-beginning p)))) - #+end_src -* Close page and reopen - #+begin_src emacs-lisp - (defvar jao-eww--closed-urls ()) - - (defun jao-eww-close () - (interactive nil eww-mode) - (when-let (current (eww-current-url)) - (add-to-list 'jao-eww--closed-urls current)) - (let ((nxt (car (jao-eww-session-invisible-buffers)))) - (kill-current-buffer) - (when nxt (switch-to-buffer nxt nil t)))) - - (defun jao-eww-reopen (arg) - (interactive "P") - (if (> (length jao-eww--closed-urls) 0) - (let ((url (completing-read "URL: " jao-eww--closed-urls))) - (jao-afio--goto-www) - (setq jao-eww--closed-urls (remove url jao-eww--closed-urls)) - (eww url (when arg 4))) - (message "No previously closed URLs."))) - - (defun jao-eww-reopen-new () - (interactive) - (jao-eww-reopen t)) - #+end_src -* Sessions - #+begin_src emacs-lisp - (use-package jao-eww-session - :custom ((jao-eww-session-file "~/.emacs.d/cache/eww-session.eld"))) - #+end_src -* Package - #+begin_src emacs-lisp - (use-package shr - :custom ((shr-width nil) - (shr-use-colors t) - (shr-use-fonts t) - (shr-max-width 130) - (shr-blocked-images nil) - (shr-inhibit-images t) - (shr-max-image-proportion 1.0) - (shr-hr-line ?―))) - - (use-package eww - :demand t - :custom ((eww-browse-url-new-window-is-tab nil) - (eww-download-directory jao-sink-dir) - (eww-header-line-format " %u") - (eww-form-checkbox-selected-symbol "☒") - (eww-buffer-name-length 180)) - - :config - (with-eval-after-load "org" (require 'ol-eww nil t)) - - (defun jao-eww-buffer-name () - (when-let ((s (or (plist-get eww-data :title) - (plist-get eww-data :url)))) - (when (not (string-blank-p s)) (format "%s" s)))) - (setq eww-auto-rename-buffer #'jao-eww-buffer-name) - - :bind (:map eww-mode-map (("b" . eww-back-url) - ("B" . eww-forward-url) - ("d" . jao-download) - ("f" . link-hint-open-link) - ("F" . embark-on-link) - ("L" . eww-forward-url) - ("N" . jao-eww-next-image) - ("o" . jao-eww-browse) - ("O" . jao-eww-browse-new) - ("r" . jao-eww-reload) - ("s" . eww-search-words) - ("S" . jao-eww-browse-new) - ("u" . jao-eww-reopen) - ("U" . jao-eww-reopen-new) - ("w" . org-eww-copy-for-org-mode) - ("q" . jao-eww-close) - ("x" . jao-rss-subscribe) - ("y" . jao-eww-copy-link) - ("\\" . eww-view-source) - ("C-c C-w" . jao-eww-close) - ("M-i" . eww-toggle-images)))) - - #+end_src -* Fixes for shr image rendering - #+begin_src emacs-lisp - (require 'shr) - - (defun jao-shr--kill-nl (p) - (save-excursion - (goto-char p) - (when (looking-at-p "\n") (delete-char 1)))) - - (defun jao-shr-tag-img (fn &rest args) - (let ((p (point))) - (prog1 (apply fn args) - (when (> (point) p) (jao-shr--kill-nl p))))) - - (defun jao-shr-insert (fn &rest args) - (let ((p (when (and (not (bolp)) - (get-text-property (1- (point)) 'image-url)) - (point)))) - (prog1 (apply fn args) - (when (and p (> (point) p)) (jao-shr--kill-nl p))))) - - (advice-add 'shr-tag-img :around #'jao-shr-tag-img) - (advice-add 'shr-insert :around #'jao-shr-insert) - - #+end_src diff --git a/exwm.org b/exwm.org deleted file mode 100644 index b74fce8..0000000 --- a/exwm.org +++ /dev/null @@ -1,563 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" :tangle-mode (identity #o644) -#+title: exwm configuration -#+auto_tangle: t - -* Load and basic config - #+begin_src emacs-lisp - (defvar jao-exwm--use-afio t) - - (jao-load-path "exwm") - - (use-package exwm - :ensure t - :init (setq exwm-debug nil - exwm-workspace-number 1 - exwm-workspace-show-all-buffers t - exwm-workspace-warp-cursor nil - exwm-layout-show-all-buffers t - exwm-floating-border-color - (if (jao-colors-scheme-dark-p) "black" "grey90"))) - - (use-package exwm-edit :ensure t) - (require 'exwm) - #+end_src -* Frame(s) as workspaces - #+begin_src emacs-lisp - (defun jao-exwm--new-frame-p () - (not (frame-parameter nil 'jao-frames-initialized))) - - (defun jao-exwm--mark-frame (force) - (prog1 (or force (jao-exwm--new-frame-p)) - (set-frame-parameter nil 'jao-frames-initialized t))) - - (defun jao-exwm--goto-main (&optional init) - (interactive "P") - (exwm-workspace-switch-create 1) - (when (jao-exwm--mark-frame init) (jao-trisect))) - - (defun jao-exwm--goto-mail (&optional init) - (interactive "P") - (exwm-workspace-switch-create 2) - (when (jao-exwm--mark-frame init) - (jao-afio-open-gnus))) - - (defun jao-exwm--goto-www (&optional init) - (interactive "P") - (exwm-workspace-switch-create 5) - (when (jao-exwm--mark-frame init) - (jao-afio-open-www) - (let ((scroll-bar-mode 'left)) - (toggle-scroll-bar 1) - (set-frame-parameter (window-frame) 'scroll-bar-width 12)) - (jao-toggle-inactive-mode-line))) - - (defun jao-exwm--goto-docs (&optional init) - (interactive "P") - (exwm-workspace-switch-create 4) - (when (jao-exwm--mark-frame init) - (jao-afio-open-doc))) - - (defun jao-exwm-open-doc (file) - (jao-exwm--goto-docs) - (jao-find-or-open file)) - - (defun jao-exwm-no-afio-setup () - (interactive) - (defalias 'jao-open-gnus-frame 'jao-exwm--goto-mail) - (defalias 'jao-goto-www-frame 'jao-exwm--goto-www) - (setq jao-open-doc-fun #'jao-exwm-open-doc) - (setq minibuffer-follows-selected-frame t) - (global-set-key "\C-cf" 'jao-exwm--goto-main) - (global-set-key "\C-cg" 'jao-exwm--goto-mail) - (global-set-key "\C-cw" 'jao-exwm--goto-www) - (global-set-key "\C-cz" 'jao-exwm--goto-docs)) - - (if jao-exwm--use-afio - (setq minibuffer-follows-selected-frame nil) - (jao-exwm-no-afio-setup)) - #+end_src -* Tracking - #+begin_src emacs-lisp - (add-hook 'exwm-workspace-switch-hook 'tracking-remove-visible-buffers) - #+end_src -* Buffer names - #+begin_src emacs-lisp - (defun jao-exwm--use-title-p () - (and exwm-title (not (string-blank-p exwm-title)))) - - (defun jao-exwm-rename-buffer/class () - (unless (jao-exwm--use-title-p) - (exwm-workspace-rename-buffer exwm-class-name))) - - (defun jao-exwm-rename-buffer/title () - (cond ((or (not exwm-instance-name) - (jao-exwm--use-title-p)) - (exwm-workspace-rename-buffer exwm-title)) - ((string= "Zathura" exwm-class-name) - (exwm-workspace-rename-buffer - (format "zathura: %s" (file-name-nondirectory exwm-title)))))) - - (defun jao-exwm--set-exwm-name () - (when (not jao-exwm--name) - (setq jao-exwm--name jao-exwm--current-name - jao-exwm--current-name nil))) - - (add-hook 'exwm-mode-hook 'jao-exwm--set-exwm-name) - (add-hook 'exwm-update-class-hook 'jao-exwm-rename-buffer/class) - (add-hook 'exwm-update-title-hook 'jao-minibuffer-refresh) - (add-hook 'exwm-update-title-hook 'jao-exwm-rename-buffer/title) - #+end_src -* Float windows - #+begin_src emacs-lisp - (defvar jao-exwm-max-x (x-display-pixel-width)) - (defvar jao-exwm-max-y (x-display-pixel-height)) - - (defun jao-exwm--float-to (x y &optional w h) - (let* ((w (or w (frame-pixel-width))) - (h (or h (frame-pixel-height))) - (x (if (< x 0) (- jao-exwm-max-x (- x) w) x)) - (y (if (< y 0) (- jao-exwm-max-y (- y) h) y)) - (p (or (frame-parameter nil 'jao-position) (frame-position)))) - (exwm-floating-move (- x (car p)) (- y (cdr p))) - (exwm-layout-enlarge-window-horizontally (- w (frame-pixel-width))) - (exwm-layout-enlarge-window (- h (frame-pixel-height))) - (set-frame-parameter nil 'jao-position (cons x y)))) - - (defun jao-exwm--center-float (&optional w h) - (interactive) - (let* ((mx jao-exwm-max-x) - (my jao-exwm-max-y) - (w (or w (frame-pixel-width))) - (h (or h (/ (* w my) mx)))) - (jao-exwm--float-to (/ (- mx w) 2) (/ (- my h) 2) w h))) - - (defun jao-exwm--setup-float () - (set-frame-parameter nil 'jao-position nil) - (cond ((string= "Firefox" exwm-class-name) - (jao-exwm--center-float 900 600)) - ((member exwm-class-name '("mpv" "vlc")) - (jao-exwm--center-float 1200)))) - - (defvar jao-exwm-floating-classes '("mpv" "vlc")) - (setq jao-exwm-floating-classes nil) - - (defun jao-exwm--maybe-float () - (when (member exwm-class-name jao-exwm-floating-classes) - (when (not exwm--floating-frame) - (exwm-floating-toggle-floating)))) - - (add-hook 'exwm-floating-setup-hook #'jao-exwm--setup-float) - (add-hook 'exwm-manage-finish-hook #'jao-exwm--maybe-float) - - #+end_src -* Minibuffer - #+begin_src emacs-lisp - (setq jao-minibuffer-frame-width 271) - (add-hook 'exwm-workspace-switch-hook #'jao-minibuffer-refresh) - #+end_src -* System tray - #+begin_src emacs-lisp - (require 'exwm-systemtray) - (exwm-systemtray-enable) - - (defun jao-exwm--watch-tray (sym newval op where) - (setq jao-minibuffer-right-margin (* 2 (length newval))) - (jao-minibuffer-refresh)) - - (add-variable-watcher 'exwm-systemtray--list #'jao-exwm--watch-tray) - #+end_src -* Switch to buffer / app - #+begin_src emacs-lisp - (defvar-local jao-exwm--name nil) - (defvar jao-exwm--current-name nil) - - (defun jao-exwm--check-name (name) - (or (string= jao-exwm--name name) - (string= (buffer-name) name) - (string= exwm-class-name name) - (string= exwm-title name))) - - (defun jao-exwm-find-class-buffer (cln) - (if (jao-exwm--check-name cln) - (current-buffer) - (let* ((cur-buff (current-buffer)) - (bfs (seq-filter (lambda (b) - (and (not (eq b cur-buff)) - (with-current-buffer b - (jao-exwm--check-name cln)))) - (buffer-list)))) - (when (car bfs) (car (reverse bfs)))))) - - (defun jao-exwm-switch-to-class/title (cln) - (interactive) - (when cln - (if (jao-exwm--check-name cln) - (current-buffer) - (when-let ((b (jao-exwm-find-class-buffer cln))) - (pop-to-buffer b))))) - - (defun jao-exwm-switch-to-next-class () - (interactive) - (jao-exwm-switch-to-class/title exwm-class-name)) - - (defun jao-exwm-switch-to-next-x () - (interactive) - (let ((bfs (seq-filter (lambda (b) (buffer-local-value 'exwm-class-name b)) - (buffer-list (window-frame))))) - (when (car bfs) (switch-to-buffer (car (reverse bfs)))))) - - #+end_src -* App runners - #+begin_src emacs-lisp - (defun jao-exwm-run (command) - (interactive - (list (read-shell-command "$ " - (if current-prefix-arg - (cons (concat " " (buffer-file-name)) 0) - "")))) - (setq jao-exwm--current-name nil) - (start-process-shell-command command nil command)) - - (defmacro jao-exwm-runner (&rest args) - `(lambda () (interactive) (start-process "" nil ,@args))) - - (defun jao-exwm-workspace (n) - (if jao-exwm--use-afio - (jao-afio-goto-nth n) - (exwm-workspace-switch-create n))) - - (defmacro jao-def-exwm-runner (name ws class &rest args) - `(defun ,name (&rest other-args) - (interactive) - ,@(when ws `((jao-exwm-workspace ,ws))) - (if (jao-exwm-switch-to-class/title ,class) - ,(or (stringp (car args)) args) - (setq jao-exwm--current-name ,class) - ,(if (stringp (car args)) - `(start-process-shell-command ,(car args) - "* exwm - console *" - (string-join (append (list ,@args) - other-args) - " ")) - args)))) - - (jao-def-exwm-runner jao-exwm-spotify 0 "Spotify" "spotify") - (jao-def-exwm-runner jao-exwm-spt 0 "spt" "xterm" "-e" "spt") - - (jao-def-exwm-runner jao-exwm-firefox 5 "Firefox" "firefox") - - (defun jao-exwm-firefox-1 () - (interactive) - (jao-exwm-firefox) - (delete-other-windows)) - - (defun jao-exwm-browse-with-firefox (&rest args) - (jao-exwm-firefox-1) - (apply #'browse-url-firefox args)) - (setq browse-url-secondary-browser-function #'jao-exwm-browse-with-firefox) - - (jao-def-exwm-runner jao-exwm-vlc 4 "VLC" "vlc") - - (jao-def-exwm-runner jao-exwm-slack 0 "Slack" "slack") - (jao-def-exwm-runner jao-exwm-signal 0 "Signal" "signal-desktop") - - (jao-def-exwm-runner jao-exwm-proton-bridge 0 "*proton-bridge*" "protonmail-bridge") - - ;; (jao-def-exwm-runner jao-exwm-htop 0 "htop-xterm" - ;; "xterm" "-title" "htop-xterm" "-e" "htop") - (jao-def-exwm-runner jao-exwm-htop 0 "htop" jao-term-htop) - - ;; (jao-def-exwm-runner jao-exwm-aptitude 0 "aptitude-xterm" - ;; "xterm" "-title" "aptitude-xterm" "-e" "aptitude") - (jao-def-exwm-runner jao-exwm-aptitude 0 "aptitude" jao-term-aptitude) - - (jao-def-exwm-runner jao-exwm-blueman 0 "Blueman-manager" "blueman-manager") - (jao-def-exwm-runner jao-exwm-ncmpcpp 0 "ncmpcpp" "xterm" "-e" "ncmpcpp" "-p" "6669") - (jao-def-exwm-runner jao-exwm-mpc 0 "*MPC-Status*" mpc) - - (jao-def-exwm-runner jao-exwm-proton-vpn 0 "*pvpn*" proton-vpn-status) - (jao-def-exwm-runner jao-exwm-enwc 0 "*ENWC*" enwc) - (jao-def-exwm-runner jao-exwm-bluetooth 0 "*Bluetooth*" bluetooth-list-devices) - (jao-def-exwm-runner jao-exwm-packages 0 "*Packages*" list-packages nil) - (jao-def-exwm-runner jao-exwm-proced 0 "*Proced*" proced) - - (jao-def-exwm-runner jao-exwm-open-with-zathura nil nil "zathura" (buffer-file-name)) - (jao-def-exwm-runner jao-exwm-open-with-mupdf nil nil "mupdf" (buffer-file-name)) - (jao-def-exwm-runner jao-exwm-xterm 0 nil "xterm") - - (defun jao-exwm-import-screen (&optional area) - (interactive "P") - (when (not (file-directory-p "/tmp/screenshot")) - (make-directory "/tmp/screenshot")) - (let ((c (format "import %s %s" - (if area "" "-window root") - "/tmp/screenshot/$(date +'%g%m%d-%H%M%S').png"))) - (start-process-shell-command "import" "* exwm - console *" c))) - - (defun jao-exwm--send-str (str) - (dolist (k (string-to-list (kbd str))) - (exwm-input--fake-key k))) - - #+end_src -* Deezer support - #+begin_src emacs-lisp - (jao-def-exwm-runner jao-exwm-deezer-1 5 "Deezer" "deezer-desktop") - - (defun jao-exwm-deezer () - (interactive) - (jao-exwm-deezer-1) - (delete-other-windows)) - - (defalias 'jao-streaming-list #'jao-exwm-deezer) - - (defun jao-exwm--with-deezer (fun) - (jao-exwm-deezer) - (funcall fun)) - - (defun jao-exwm-deezer-like () - (interactive) - (jao-exwm-deezer) - (jao-exwm--send-str "L")) - - #+end_src -* Zathura support - #+begin_src emacs-lisp - (defun jao-zathura--buffer-p (b) - (string= "Zathura" (or (buffer-local-value 'exwm-class-name b) ""))) - - (defun jao-zathura--buffers () - (seq-filter #'jao-zathura--buffer-p (buffer-list))) - - (defun jao-zathura--file-info (b) - (with-current-buffer b - (jao-zathura-file-info (or exwm-title "")))) - - (defun jao-zathura-goto-page (page-no) - (jao-exwm--send-str (format "%sg" page-no))) - - (defun jao-zathura-open-doc (&optional file-name page-no height) - (interactive) - (let* ((file-name (expand-file-name (or file-name (buffer-file-name)))) - (buffer (seq-find `(lambda (b) - (string= ,file-name - (car (jao-zathura--file-info b)))) - (jao-zathura--buffers))) - (page-no (or page-no (jao-doc-view-current-page)))) - (if jao-exwm--use-afio (jao-afio--goto-docs) (jao-exwm--goto-docs)) - (if (not buffer) - (jao-exwm-run (if page-no - (format "zathura -P %s '%s'" page-no file-name) - (format "zathura '%s'" file-name))) - (pop-to-buffer buffer) - (when page-no (jao-zathura-goto-page page-no))) - (current-buffer))) - - (defun jao-exwm--zathura-setup () - (when (and (string= exwm-class-name "Zathura") - (not jao-doc-view--imenu-file)) - (let ((info (jao-zathura--file-info (current-buffer)))) - (jao-doc-view-session-mark (car info)) - (jao-doc-view-save-session) - (jao-doc-view--enable-imenu (car info) #'jao-zathura-goto-page)))) - - (add-hook 'exwm-update-title-hook #'jao-exwm--zathura-setup t) - - (defun jao-exwm-pdf-zathura-close-all () - (interactive) - (dolist (b (jao-zathura--buffers)) - (ignore-errors - (switch-to-buffer b) - (jao-exwm--send-str "q"))) - t) - - (defun jao-exwm-zathura-goto-org (&optional arg) - (interactive "P") - (when-let ((info (jao-zathura--file-info (current-buffer)))) - (when-let ((file (jao-org-pdf-to-org-file (car info)))) - (let ((newp (not (file-exists-p file)))) - (when (or arg newp) (org-store-link nil t)) - (find-file-other-window file) - (when newp - (jao-org-insert-doc-skeleton) - (org-insert-link)))))) - - (defun jao-exwm-zathura-goto-org* () - (interactive) - (jao-exwm-zathura-goto-org t)) - - (defun jao-exwm-org-store-zathura-link () - (when-let ((info (jao-zathura--file-info (current-buffer)))) - (let* ((file-name (car info)) - (page (cadr info)) - (desc (jao-doc-view-section-title page file-name))) - (jao-org-links-store-pdf-link file-name page desc)))) - - (defun jao-exwm-pdf-enable-zathura () - (interactive) - (add-hook 'kill-emacs-query-functions #'jao-exwm-pdf-zathura-close-all t) - (setq jao-org-open-pdf-fun #'jao-zathura-open-doc) - (setq jao-org-links-pdf-store-fun #'jao-exwm-org-store-zathura-link) - (setq jao-open-doc-fun #'jao-zathura-open-doc)) - - (defun jao-exwm-pdf-disable-zathura () - (interactive) - (define-key org-mode-map (kbd "C-c o") #'jao-org-org-goto-pdf) - (remove-hook 'kill-emacs-query-functions #'jao-exwm-pdf-zathura-close-all) - (setq jao-org-open-pdf-fun #'jao-find-or-open) - (setq jao-org-links-pdf-store-fun nil) - (setq jao-open-doc-fun #'jao-find-or-open)) - - (defun jao-exwm-zathura-goto-pdf () - (interactive) - (if jao-browse-doc-use-emacs-p - (jao-org-org-goto-pdf) - (when-let (pdf (jao-org-org-to-pdf-file)) - (jao-zathura-open-doc pdf)))) - - (with-eval-after-load "org" - (define-key org-mode-map (kbd "C-c o") #'jao-exwm-zathura-goto-pdf)) - - (when (not jao-browse-doc-use-emacs-p) - (jao-exwm-pdf-enable-zathura)) - - (defun jao-exwm-select-pdf () - (interactive) - (let ((b (read-buffer "Document: " nil t - (lambda (b) - (let ((b (cdr b))) - (or (jao-zathura--buffer-p b) - (member (buffer-local-value 'major-mode b) - '(pdf-view-mode doc-view-mode)))))))) - (jao-afio--goto-docs) - (pop-to-buffer b))) - - - (let ((viewers ["External viewers" - ("z" "open with zathura" jao-zathura-open-doc) - ("m" "open with mupdf" jao-exwm-open-with-mupdf)])) - (jao-transient-major-mode+ pdf-view viewers) - (jao-transient-major-mode+ doc-view viewers)) - - #+end_src -* Firefox helpers - #+begin_src emacs-lisp - (defun jao-exwm-kill-firefox-url () - (interactive) - (when-let (b (jao-exwm-find-class-buffer "Firefox")) - (let ((cb (current-buffer))) - (switch-to-buffer b) - (jao-exwm--send-str "yy") - (switch-to-buffer cb)))) - - (defun jao-exwm-toggle-firefox (ff) - (interactive "P") - (if (and (not ff) (equal exwm-class-name "Firefox")) - (jao-afio--goto-main) - (jao-exwm-firefox-1))) - - #+end_src -* Transients - #+begin_src emacs-lisp - (defun jao-exwm--floating-p () exwm--floating-frame) - (defun jao-exwm--m0-5 () (interactive nil exwm-mode) (exwm-floating-move 0 -5)) - (defun jao-exwm--m05 () (interactive nil exwm-mode) (exwm-floating-move 0 5)) - (defun jao-exwm--m-50 () (interactive nil exwm-mode) (exwm-floating-move -5 0)) - (defun jao-exwm--m50 () (interactive nil exwm-mode) (exwm-floating-move 5 0)) - (defun jao-exwm--e-5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window -5)) - (defun jao-exwm--e5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window 5)) - (defun jao-exwm--eh5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window 5 t)) - (defun jao-exwm--eh-5 () (interactive nil exwm-mode) (exwm-layout-enlarge-window -5 t)) - (defun jao-exwm--tl () (interactive nil exwm-mode) (jao-exwm--float-to 20 20)) - (defun jao-exwm--tr () (interactive nil exwm-mode) (jao-exwm--float-to -20 20)) - (defun jao-exwm--bl () (interactive nil exwm-mode) (jao-exwm--float-to 20 -20)) - (defun jao-exwm--br () (interactive nil exwm-mode) (jao-exwm--float-to -20 -20)) - - (defun jao-exwm--def-center-float () - (interactive) - (exwm-floating-toggle-floating) - (jao-exwm--center-float 900 600)) - - (transient-define-prefix jao-transient-float () - "Operations on EXWM floating windows." - :transient-non-suffix 'transient--do-quit-one - [["Float" - ("f" "float" exwm-floating-toggle-floating) - ("F" "full" exwm-layout-toggle-fullscreen) - ("c" "center" jao-exwm--center-float :if jao-exwm--floating-p) - ("c" "float and resize" jao-exwm--def-center-float - :if-not jao-exwm--floating-p) - ("x" "hide" exwm-floating-hide :if jao-exwm--floating-p)] - ["Slide" :if jao-exwm--floating-p - ("k" "up" jao-exwm--m0-5 :transient t) - ("j" "down" jao-exwm--m05 :transient t) - ("h" "left" jao-exwm--m-50 :transient t) - ("l" "right" jao-exwm--m50 :transient t)] - ["Resize" :if jao-exwm--floating-p - ("K" "up" jao-exwm--e5 :transient t) - ("J" "down" jao-exwm--e-5 :transient t) - ("H" "left" jao-exwm--eh5 :transient t) - ("L" "right" jao-exwm--eh-5 :transient t)] - ["Nudge" :if jao-exwm--floating-p - ("t" "top-left" jao-exwm--tl) - ("T" "top-right" jao-exwm--tr) - ("b" "bottom-left" jao-exwm--bl) - ("B" "bottom-right " jao-exwm--br)]]) - - (defun jao-exwm--buffer () - (interactive) - (jao-buffer-same-mode 'exwm-mode nil 'exwm-workspace-switch-to-buffer)) - - #+end_src -* Keybindings - #+begin_src emacs-lisp - (define-key exwm-mode-map [?\C-q] #'exwm-input-send-next-key) - (define-key exwm-mode-map [?\s-f] #'jao-transient-float) - (define-key exwm-mode-map (kbd "C-c o") #'jao-exwm-zathura-goto-org) - (define-key exwm-mode-map (kbd "C-c O") #'jao-exwm-zathura-goto-org*) - (define-key exwm-mode-map (kbd "M-o") #'other-window) - (define-key exwm-mode-map (kbd "M-p") #'jao-prev-window) - - (setq - exwm-input-global-keys - '(([?\s-0] . jao-afio--goto-scratch) - ([?\s-1] . jao-afio--goto-main) - ([?\s-2] . jao-afio--goto-mail) - ([?\s-3] . jao-afio--goto-www) - ([?\s-4] . jao-afio--goto-docs) - ([?\s-A] . org-agenda-list) - ([?\s-a] . jao-first-window) - ([?\s-b] . jao-transient-org-blog) - ([?\s-e] . jao-exwm-toggle-firefox) - ([?\s-m] . jao-transient-media) - ;; ([?\s-O] . jao-transpose-windows) - ;; ([?\s-o] . jao-other-window) - ;; ([?\s-P] . jao-transpose-windows-prev) - ([?\s-O] . ace-swap-window) - ([?\s-o] . ace-window) - ([?\s-p] . jao-prev-window) - ([?\s-R] . app-launcher-run-app) - ([?\s-r] . jao-recoll-transient) - ([?\s-s] . jao-transient-streaming) - ([?\s-t] . vterm) - ([?\s-w] . jao-transient-utils) - ([?\s-z] . jao-transient-sleep) - ([XF86AudioMute] . jao-mixer-master-toggle) - ([XF86AudioPlay] . jao-player-toggle) - ([XF86AudioPause] . jao-player-toggle) - ([XF86AudioNext] . jao-player-next) - ([XF86AudioPrev] . jao-player-previous) - ([XF86AudioRaiseVolume] . jao-mixer-master-up) - ([XF86AudioLowerVolume] . jao-mixer-master-down) - ([XF86MonBrightnessUp] . jao-bright-up) - ([XF86MonBrightnessDown] . jao-bright-down) - ([?\s-\`] . jao-exwm-switch-to-next-x) - ([s-tab] . jao-exwm-switch-to-next-class) - ([print] . jao-exwm-import-screen) - ([f5] . jao-weather) - ([f6] . jao-toggle-audio-applet) - ([f8] . jao-toggle-nm-applet) - ([f9] . jao-bright-show))) - - ;; (customize-set-variable 'exwm-input-global-keys exwm-input-global-keys) - - #+end_src diff --git a/gnus.org b/gnus.org deleted file mode 100644 index c0c0346..0000000 --- a/gnus.org +++ /dev/null @@ -1,780 +0,0 @@ -#+property: header-args :lexical t :tangle ~/.emacs.d/gnus.el :comments yes :results silent :shebang ";; -*- lexical-binding: t -*-" :tangle-mode (identity #o644) -#+title: Gnus - -* Feature switching vars - #+begin_src emacs-lisp - (defvar jao-gnus-use-local-imap nil) - (defvar jao-gnus-use-leafnode nil) - (defvar jao-gnus-use-gandi-imap nil) - (defvar jao-gnus-use-pm-imap nil) - (defvar jao-gnus-use-gmane nil) - (defvar jao-gnus-use-nnml nil) - (defvar jao-gnus-use-maildirs nil) - #+end_src -* Startup and kill - #+begin_src emacs-lisp - ;;;;; close gnus when closing emacs, but ask when exiting - (setq gnus-interactive-exit t) - - (defun jao-gnus-started-hook () - (add-hook 'before-kill-emacs-hook 'gnus-group-exit)) - - (add-hook 'gnus-started-hook 'jao-gnus-started-hook) - - (defun jao-gnus-after-exiting-hook () - (remove-hook 'before-kill-emacs-hook 'gnus-group-exit)) - - (add-hook 'gnus-after-exiting-gnus-hook 'jao-gnus-after-exiting-hook) - - ;; define a wrapper around the save-buffers-kill-emacs - ;; to run the new hook before: - (defadvice save-buffers-kill-emacs - (before my-save-buffers-kill-emacs activate) - "Install hook when emacs exits before emacs asks to save this and that." - (run-hooks 'before-kill-emacs-hook)) - #+end_src -* Directories - #+begin_src emacs-lisp - (defun jao-gnus-dir (dir) - (expand-file-name dir gnus-home-directory)) - - (setq smtpmail-queue-dir (jao-gnus-dir "Mail/queued-mail/")) - - (setq mail-source-directory (jao-gnus-dir "Mail/") - message-directory (jao-gnus-dir "Mail/")) - - (setq gnus-default-directory (expand-file-name "~") - gnus-startup-file (jao-gnus-dir "newsrc") - gnus-agent-directory (jao-gnus-dir "News/agent") - gnus-home-score-file (jao-gnus-dir "scores") - gnus-article-save-directory (jao-gnus-dir "saved/") - nntp-authinfo-file (jao-gnus-dir "authinfo") - nnmail-message-id-cache-file (jao-gnus-dir "nnmail-cache") - nndraft-directory (jao-gnus-dir "drafts") - nnrss-directory (jao-gnus-dir "rss")) - #+end_src -* Looks -*** Verbosity - #+begin_src emacs-lisp - (setq gnus-verbose 4) - #+end_src -*** Geometry - #+begin_src emacs-lisp - ;;; geometry: - (defvar jao-gnus-use-three-panes window-system) - (defvar jao-gnus-groups-width 50) - (defvar jao-gnus-wide-width 190) - - (setq gnus-use-trees nil - gnus-generate-tree-function 'gnus-generate-horizontal-tree - gnus-tree-minimize-window nil) - - (when jao-gnus-use-three-panes - (let ((side-bar '(vertical 1.0 - ("inbox.org" 0.4) - ("*Org Agenda*" 1.0) - ("*Calendar*" 8))) - (wide-len jao-gnus-wide-width) - (groups-len jao-gnus-groups-width) - (summary-len (- jao-gnus-wide-width jao-gnus-groups-width))) - (gnus-add-configuration - `(article - (horizontal 1.0 - (vertical ,groups-len (group 1.0)) - (vertical ,summary-len - (summary 0.25 point) - (article 1.0)) - ,side-bar))) - - (gnus-add-configuration - `(group (horizontal 1.0 (group ,wide-len point) ,side-bar))) - - (gnus-add-configuration - `(message (horizontal 1.0 (message ,wide-len point) ,side-bar))) - - (gnus-add-configuration - `(reply-yank (horizontal 1.0 (message ,wide-len point) ,side-bar))) - - (gnus-add-configuration - `(summary - (horizontal 1.0 - (vertical ,groups-len (group 1.0)) - (vertical ,summary-len (summary 1.0 point)) - ,side-bar))) - - (gnus-add-configuration - `(reply - (horizontal 1.0 - (message ,(- wide-len 100) point) - (article 100) - ,side-bar))))) - #+end_src -*** No blue icon - #+begin_src emacs-lisp - (advice-add 'gnus-mode-line-buffer-identification :override #'identity) - (setq gnus-mode-line-image-cache nil) - #+end_src -* Search - #+begin_src emacs-lisp - - (setq gnus-search-use-parsed-queries t - gnus-search-notmuch-raw-queries-p nil - gnus-permanently-visible-groups "^nnselect:.*" - gnus-search-ignored-newsgroups "nndraft.*\\|nnselect.*") - - (with-eval-after-load "gnus-search" - (add-to-list 'gnus-search-expandable-keys "list") - - (cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) - (expr (head list))) - (format "List:%s" (gnus-search-transform-expression engine (cdr expr))))) - - (defun jao-gnus--notmuch-engine (prefix config) - (let ((prefix (file-name-as-directory (expand-file-name prefix "~"))) - (config (expand-file-name config gnus-home-directory))) - `(gnus-search-engine gnus-search-notmuch - (remove-prefix ,prefix) - (config-file ,config)))) - - ;; (add-to-list 'gnus-parameters '("^nnselect:.*" (nnselect-rescan . t))) - - #+end_src -* News server - #+begin_src emacs-lisp - (setq gnus-select-method - (cond - (jao-gnus-use-leafnode - `(nntp "localhost" - ,(jao-gnus--notmuch-engine "var/news" "notmuch-news.config"))) - (jao-gnus-use-gmane '(nntp "news.gmane.io")) - (t '(nnnil "")))) - - (setq gnus-secondary-select-methods '()) - - (setq nnheader-read-timeout 0.02 - gnus-save-newsrc-file nil) ; .newsrc only needed by other newsreaders - #+end_src -* Local mail -*** nnmail params - #+begin_src emacs-lisp - (setq nnmail-treat-duplicates 'delete - nnmail-scan-directory-mail-source-once nil - nnmail-cache-accepted-message-ids t - nnmail-message-id-cache-length 100000 - nnmail-split-fancy-with-parent-ignore-groups nil - nnmail-use-long-file-names t - nnmail-crosspost t - nnmail-resplit-incoming t - nnmail-mail-splitting-decodes t - nnmail-split-methods 'nnmail-split-fancy) - #+end_src -*** nnml - #+begin_src emacs-lisp - (setq mail-sources - (when jao-gnus-use-nnml - (cons '(file :path "/var/mail/jao") - (when (eq jao-afio-mail-function 'gnus) - (mapcar (lambda (d) `(maildir :path ,(concat d "/"))) - (directory-files "~/var/mail" t "[^\\.]"))))) - gnus-message-archive-group nil - nnml-get-new-mail t - nnml-directory message-directory) - - (when jao-gnus-use-nnml - (add-to-list - 'gnus-secondary-select-methods - `(nnml "" ,(jao-gnus--notmuch-engine (jao-gnus-dir "Mail") "notmuch.config")))) - - (defvar jao-gnus-nnml-group-params - `(("nnml:\\(local\\|trash\\|spam\\)" - (auto-expire . t) - (total-expire . t) - (expiry-wait . 1) - (expiry-target . delete)) - ("nnml:jao\\..*" - (posting-style ("Bcc" "proton@jao.io") - ("Gcc" "nnml:jao.trove")) - (jao-gnus--trash-group "nnml:trash") - (jao-gnus--spam-group "nnml:spam") - (jao-gnus--archiving-group "nnml:jao.trove")) - ("nnml:bigml\\..*" - (gcc-self . nil) - (auto-expire . t) - (total-expire . t) - (expiry-wait . 3) - (expiry-target . delete) - (posting-style (address "jao@bigml.com")) - (jao-gnus--trash-group "nnml:trash") - (jao-gnus--spam-group "nnml:spam") - (jao-gnus--archiving-group "nnml:bigml.trove")) - ("nnml:bigml\\.\\(inbox\\|support\\)" - (gcc-self . t) - (auto-expire . t) - (total-expire . t) - (expiry-wait . 7) - (expiry-target . "nnml:bigml.trove")) - ("nnml:bigml\\.trove" - (auto-expire . t) - (total-expire . t) - (expiry-target . delete) - (expiry-wait . 365)) - ("nnml:jao\\.drivel" - (auto-expire . t) - (total-expire . t) - (expiry-wait . 3) - (expiry-target . delete)) - ("nnml:feeds\\.\\(.*\\)" - (auto-expire . t) - (total-expire . t) - (expiry-wait . 7) - (expiry-target . delete) - (comment . "feeds.\\1") - (jao-gnus--archiving-group "nnml:feeds.trove")) - ("^nnml:feeds\\.\\(news\\)$" (expiry-wait . 2)) - ("nnml:feeds\\.\\(trove\\|lobsters\\|philosophy\\)" - (auto-expire . nil) - (total-expire . nil)) - ("nnml:feeds\\.fun" - (mm-html-inhibit-images nil) - (mm-html-blocked-images nil)))) - - (when jao-gnus-use-nnml - (dolist (p jao-gnus-nnml-group-params) - (add-to-list 'gnus-parameters p t))) - - #+end_src -*** leafnode - #+begin_src emacs-lisp - (defvar jao-gnus-image-groups '("xkcd")) - - (defvar jao-gnus-leafnode-group-params - `((,(format "gwene\\..*%s.*" (regexp-opt jao-gnus-image-groups)) - (mm-html-inhibit-images nil) - (mm-html-blocked-images nil)) - ("\\(gmane\\|gwene\\)\\..*" - (jao-gnus--archiving-group "nnml:feeds.trove") - (posting-style (address "jao@gnu.org"))))) - - (when jao-gnus-use-leafnode - (dolist (p jao-gnus-leafnode-group-params) - (add-to-list 'gnus-parameters p t))) - - #+end_src -*** maildirs - #+begin_src emacs-lisp - (when jao-gnus-use-maildirs - (add-to-list - 'gnus-secondary-select-methods - `(nnmaildir "mail" - (directory "~/.nnmaildirs") - ,(jao-gnus--notmuch-engine "~/var/mail/" - "~/.notmuch-config")))) - - #+end_src -* IMAP servers - #+begin_src emacs-lisp - (setq nnimap-quirks nil) - - (when jao-gnus-use-local-imap - (add-to-list 'gnus-secondary-select-methods - `(nnimap "" (nnimap-address "localhost")))) - - (when jao-gnus-use-pm-imap - (add-to-list 'gnus-secondary-select-methods - '(nnimap "pm" - (nnimap-address "127.0.0.1") - (nnimap-stream network) - (nnimap-server-port 1143)))) - - (when jao-gnus-use-gandi-imap - (add-to-list 'gnus-secondary-select-methods - '(nnimap "gandi" (nnimap-address "mail.gandi.net")))) - #+end_src -* Demon and notifications - #+begin_src emacs-lisp - (setq mail-user-agent 'gnus-user-agent) - - ;; synchronicity - (setq gnus-asynchronous t) - ;;; prefetch as many articles as possible - (setq gnus-use-article-prefetch nil) - - (setq gnus-save-killed-list nil) - (setq gnus-check-new-newsgroups nil) - - (defvar jao-gnus-tracked-groups - (let ((feeds (thread-first - (directory-files mail-source-directory nil "feeds") - (seq-difference '("feeds.trove"))))) - `(("nnml:bigml.inbox" "B" jao-themes-f00) - ("nnml:bigml.bugs" "b" jao-themes-error) - ("nnml:bigml.support" "S" default) - ("nnml:jao.inbox" "I" jao-themes-f01) - ("nnml:bigml.[^ibs]" "W" jao-themes-dimm) - ("nnml:jao.[^ist]" "J" jao-themes-dimm) - (,(format "^nnml:%s" (regexp-opt feeds)) "F" jao-themes-dimm) - ("^gmane" "G" jao-themes-dimm) - ("nnml:local" "l" jao-themes-dimm)))) - - (defun jao-gnus--unread-counts () - (seq-reduce (lambda (r g) - (let ((n (gnus-group-unread (car g)))) - (if (and (numberp n) (> n 0)) - (prog1 (cons (cons (car g) n) r) - (gnus-message 7 "%s in %s" n g)) - r))) - gnus-newsrc-alist - ())) - - (defun jao-gnus--unread-label (counts rx label face) - (let ((n (seq-reduce (lambda (n c) - (if (string-match-p rx (car c)) (+ n (cdr c)) n)) - counts - 0))) - (when (> n 0) `(:propertize ,(format "%s%d " label n) face ,face)))) - - (defvar jao-gnus--notify-strs ()) - - (defun jao-gnus--notify-strs () - (let ((counts (jao-gnus--unread-counts))) - (seq-filter #'identity - (seq-map (lambda (args) - (apply 'jao-gnus--unread-label counts args)) - jao-gnus-tracked-groups)))) - - (defun jao-gnus--notify () - (setq jao-gnus--notify-strs (jao-gnus--notify-strs)) - (save-window-excursion (jao-minibuffer-refresh))) - - (defun jao-gnus-scan () - (interactive) - (let ((inhibit-message t)) - (gnus-demon-scan-mail) - (shell-command "index-mail.sh") - (save-window-excursion ) - (jao-gnus--notify))) - - (require 'gnus-demon) - (gnus-demon-add-handler 'gnus-demon-scan-news 5 1) - ;; (gnus-demon-remove-handler 'jao-gnus-scan) - - (add-hook 'gnus-started-hook #'jao-gnus-scan) - (add-hook 'gnus-summary-exit-hook #'jao-gnus--notify) - (add-hook 'gnus-summary-exit-hook #'org-agenda-list) - (add-hook 'gnus-after-getting-new-news-hook #'jao-gnus-scan) - - (with-eval-after-load "jao-minibuffer" - (jao-minibuffer-add-variable 'jao-gnus--notify-strs -20)) - - #+end_src -* Delayed messages - #+BEGIN_SRC emacs-lisp - ;;; delayed messages (C-cC-j in message buffer) - (require 'gnus-util) - (gnus-delay-initialize) - (setq gnus-delay-default-delay "3h") - ;;; so that the Date is set when the message is sent, not when it's - ;;; delayed - (eval-after-load "message" - '(setq message-draft-headers (remove 'Date message-draft-headers))) - #+END_SRC -* Groups buffer - #+begin_src emacs-lisp - ;; (setq gnus-group-line-format " %m%S%p%P:%~(pad-right 35)c %3y %B\n") - ;; (setq gnus-group-line-format " %m%S%p%3y%P%* %~(pad-right 30)C %B\n") - (setq gnus-group-line-format " %m%S%p%3y%P%* %~(pad-right 30)G %B\n") - (setq gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n") - (setq gnus-group-uncollapsed-levels 2) - (setq gnus-auto-select-subject 'unread) - (setq-default gnus-large-newsgroup 2000) - - (add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp) - (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) - - (defvar jao-gnus--expire-every 50) - (defvar jao-gnus--get-count (1+ jao-gnus--expire-every)) - - (defun jao-gnus-get-new-news (&optional arg) - (interactive "p") - (when (and jao-gnus--expire-every - (> jao-gnus--get-count jao-gnus--expire-every)) - (when jao-gnus-use-pm-imap (gnus-group-catchup "nnimap:pm/spam" t)) - (gnus-group-expire-all-groups) - (setq jao-gnus--get-count 0)) - (setq jao-gnus--get-count (1+ jao-gnus--get-count)) - (gnus-group-get-new-news (max (if (= 1 jao-gnus--get-count) 4 3) - (or arg 0)))) - - ;; (define-key gnus-group-mode-map "g" 'jao-gnus-get-new-news) - - (defun jao-gnus-restart-servers () - (interactive) - (message "Restarting all servers...") - (gnus-group-enter-server-mode) - (gnus-server-close-all-servers) - (gnus-server-open-all-servers) - (gnus-server-exit) - (message "Restarting all servers... done")) - - (define-key gnus-group-mode-map "\C-x\C-s" #'gnus-group-save-newsrc) - - (jao-transient-major-mode gnus-group - ["Search" - ("zc" "consult search" consult-notmuch) - ("zf" "consult folder search" jao-consult-notmuch-folder) - ("g" "gnus search" gnus-group-read-ephemeral-search-group)]) - - (defun jao-gnus--first-group () - (when (derived-mode-p 'gnus-group-mode) - (gnus-group-first-unread-group))) - - (with-eval-after-load "jao-afio" - (add-hook 'jao-afio-switch-hook #'jao-gnus--first-group)) - #+end_src -* Summary buffer -*** Configuration - #+begin_src emacs-lisp - (setq gnus-face-1 'jao-gnus-face-tree) - - (setq gnus-show-threads t - gnus-thread-hide-subtree t - gnus-summary-make-false-root 'adopt - gnus-summary-gather-subject-limit 120 - gnus-sort-gathered-threads-function 'gnus-thread-sort-by-date - gnus-thread-sort-functions '(gnus-thread-sort-by-date)) - - (setq gnus-summary-ignore-duplicates t - gnus-suppress-duplicates t - ;; gnus-summary-ignored-from-addresses jao-mails-regexp - gnus-process-mark-toggle t - gnus-refer-thread-use-search t - gnus-auto-select-next 'almost-quietly) - #+end_src -*** Search - #+begin_src emacs-lisp - (defun jao-gnus--maybe-reselect (&rest _i) - (when (string-match-p "^nnselect" (or (gnus-group-name-at-point) "")) - (save-excursion (gnus-group-get-new-news-this-group)))) - - (advice-add 'gnus-group-select-group :before #'jao-gnus--maybe-reselect) - #+end_src -*** Summary line - #+begin_src emacs-lisp - (setq gnus-not-empty-thread-mark ?↓) ; ↓) ?· - (setq jao-gnus--summary-line-fmt - (concat "%%U %%*%%R %%uj " - "[ %%~(max-right 23)~(pad-right 23)uf " - " %%I%%~(pad-left 2)t ] %%s" - "%%-%s=" - "%%~(max-right 8)~(pad-left 8)&user-date;" - "\n")) - - (defun jao-gnus--set-summary-line (&optional w) - (let* ((d (if jao-gnus-use-three-panes (+ jao-gnus-groups-width 11) 12)) - (w (- (or w (window-width)) d))) - (setq gnus-summary-line-format (format jao-gnus--summary-line-fmt w)))) - - (add-hook 'gnus-select-group-hook 'jao-gnus--set-summary-line) - ;; (jao-gnus--set-summary-line 187) - - (add-to-list 'nnmail-extra-headers 'Cc) - (add-to-list 'nnmail-extra-headers 'BCc) - (add-to-list 'gnus-extra-headers 'Cc) - (add-to-list 'gnus-extra-headers 'BCc) - - (defun gnus-user-format-function-j (headers) - (let ((to (gnus-extra-header 'To headers))) - (if (string-match jao-mails-regexp to) - (if (string-match "," to) "¬" "»") ;; "~" "=") - (if (or (string-match jao-mails-regexp - (gnus-extra-header 'Cc headers)) - (string-match jao-mails-regexp - (gnus-extra-header 'BCc headers))) - "¬" ;; "~" - " ")))) - - (defconst jao-gnus--news-rx - (concat (regexp-opt '("ElDiaro.es " - "ElDiario.es - ElDiario.es: " - "The Guardian: " - "Aeon | a world of ideas: " - ": <author>")) - "\\|unofficial mirror of [^:]+: ")) - - (defun gnus-user-format-function-f (headers) - (let* ((from (gnus-header-from headers)) - (from (gnus-summary-extract-address-component from))) - (replace-regexp-in-string jao-gnus--news-rx "" from))) - - (setq gnus-user-date-format-alist - '(((gnus-seconds-today) . "%H:%M") - ((+ 86400 (gnus-seconds-today)) . "'%H:%M") - ;; (604800 . "%a %H:%M") ;; that's one week - ((gnus-seconds-month) . "%a %d") - ((gnus-seconds-year) . "%b %d") - (t . "%b '%y"))) - - #+end_src -*** Moving messages around - #+BEGIN_SRC emacs-lisp - (defvar-local jao-gnus--spam-group nil) - (defvar-local jao-gnus--archiving-group nil) - (defvar-local jao-gnus--archive-as-copy-p nil) - - (defvar jao-gnus--last-move nil) - (defun jao-gnus-move-hook (a headers c to d) - (setq jao-gnus--last-move (cons to (mail-header-id headers)))) - (defun jao-gnus-goto-last-moved () - (interactive) - (when jao-gnus--last-move - (when (eq major-mode 'gnus-summary-mode) (gnus-summary-exit)) - (gnus-group-goto-group (car jao-gnus--last-move)) - (gnus-group-select-group) - (gnus-summary-goto-article (cdr jao-gnus--last-move) nil t))) - (add-hook 'gnus-summary-article-move-hook 'jao-gnus-move-hook) - - (defun jao-gnus-archive (follow) - (interactive "P") - (if jao-gnus--archiving-group - (progn - (if (or jao-gnus--archive-as-copy-p - (not (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name))) - (gnus-summary-copy-article nil jao-gnus--archiving-group) - (gnus-summary-move-article nil jao-gnus--archiving-group)) - (when follow (jao-gnus-goto-last-moved))) - (gnus-summary-mark-as-read) - (gnus-summary-delete-article))) - - (defun jao-gnus-archive-tickingly () - (interactive) - (gnus-summary-tick-article) - (jao-gnus-archive) - (when jao-gnus--archive-as-copy-p - (gnus-summary-mark-as-read))) - - (defun jao-gnus-show-tickled () - (interactive) - (gnus-summary-limit-to-marks "!")) - - (make-variable-buffer-local - (defvar jao-gnus--trash-group nil)) - - (defun jao-gnus-trash () - (interactive) - (gnus-summary-mark-as-read) - (if jao-gnus--trash-group - (gnus-summary-move-article nil jao-gnus--trash-group) - (gnus-summary-delete-article))) - - (defun jao-gnus-move-to-spam () - (interactive) - (gnus-summary-mark-as-read) - (gnus-summary-move-article nil jao-gnus--spam-group)) - - (define-key gnus-summary-mode-map "Ba" 'jao-gnus-archive) - (define-key gnus-summary-mode-map "BA" 'jao-gnus-archive-tickingly) - (define-key gnus-summary-mode-map "Bl" 'jao-gnus-goto-last-moved) - - (define-key gnus-summary-mode-map (kbd "B DEL") 'jao-gnus-trash) - (define-key gnus-summary-mode-map (kbd "B <backspace>") 'jao-gnus-trash) - (define-key gnus-summary-mode-map "Bs" 'jao-gnus-move-to-spam) - (define-key gnus-summary-mode-map "/!" 'jao-gnus-show-tickled) - (define-key gnus-summary-mode-map [f7] 'gnus-summary-force-verify-and-decrypt) - #+END_SRC -*** Saving emails - #+BEGIN_SRC emacs-lisp - (setq gnus-default-article-saver 'gnus-summary-save-article-mail) - (defvar jao-gnus-file-save-directory (expand-file-name "~/tmp")) - (defun jao-gnus-file-save (newsgroup headers &optional last-file) - (expand-file-name (format "%s.eml" (mail-header-subject headers)) - jao-gnus-file-save-directory)) - (setq gnus-mail-save-name 'jao-gnus-file-save) - #+END_SRC -*** arXiv capture - #+begin_src emacs-lisp - (use-package org-capture - :config - (add-to-list 'org-capture-templates - '("X" "arXiv" entry (file "notes/physics/arxiv.org") - "* %:subject\n %i" :immediate-finish t) - t) - (org-capture-upgrade-templates org-capture-templates)) - - (defun jao-gnus-arXiv-capture () - (interactive) - (gnus-summary-select-article-buffer) - (gnus-article-goto-part 0) - (forward-paragraph) - (setq-local transient-mark-mode 'lambda) - (set-mark (point)) - (goto-char (point-max)) - (org-capture nil "X")) - #+end_src -* Article buffer -*** Config, headers - #+begin_src emacs-lisp - (setq mail-source-delete-incoming t) - (setq gnus-gcc-mark-as-read t) - (setq gnus-treat-display-smileys nil) - (setq gnus-treat-fill-long-lines nil) - (setq gnus-treat-fill-article nil) - (setq gnus-treat-fold-headers nil) - (setq gnus-treat-strip-leading-blank-lines t) - (setq gnus-article-auto-eval-lisp-snippets nil) - (setq gnus-posting-styles '((".*" (name "Jose A. Ortega Ruiz")))) - (setq gnus-single-article-buffer nil) - (setq gnus-article-update-lapsed-header 60) - (setq gnus-article-update-date-headers 60) - - (eval-after-load "gnus-art" - '(setq - gnus-visible-headers - (concat - gnus-visible-headers - "\\|^List-[iI][Dd]:\\|^X-Newsreader:\\|^X-Mailer:\\|User-Agent:\\|X-User-Agent:"))) - #+end_src -*** HTML email (washing, images) - #+begin_src emacs-lisp - (setq gnus-button-url 'browse-url-generic - gnus-inhibit-images t - mm-discouraged-alternatives nil ;; '("text/html" "text/richtext") - mm-inline-large-images 'resize) - - ;; no html in From: (washing articles from arxiv feeds) and cleaning up - ;; addresses - (require 'shr) - (defvar jao-gnus--from-rx - (concat "From: \\\"?\\( " jao-gnus--news-rx "\\)")) - - (defun jao-gnus-remove-anchors () - (save-excursion - (goto-char (point-min)) - (cond ((re-search-forward jao-gnus--from-rx nil t) - (replace-match "" nil nil nil 1)) - ((re-search-forward "[gq].+ updates on arXiv.org: " nil t) - (replace-match "") - (let ((begin (point))) - (when (re-search-forward "^\\(To\\|Subject\\):" nil t) - (beginning-of-line) - (let ((shr-width 10000)) - (shr-render-region begin (1- (point)))))))))) - - (add-hook 'gnus-part-display-hook 'jao-gnus-remove-anchors) - - (defvar-local jao-gnus--images nil) - - (defun jao-gnus--init-images () - (with-current-buffer gnus-article-buffer - (setq jao-gnus--images nil))) - - (add-hook 'gnus-select-article-hook #'jao-gnus--init-images) - - (defun jao-gnus-show-images () - (interactive) - (save-window-excursion - (gnus-summary-select-article-buffer) - (save-excursion - (setq jao-gnus--images (not jao-gnus--images)) - (if jao-gnus--images - (gnus-article-show-images) - (gnus-article-remove-images))))) - #+end_src -*** Follow links and enclosures - #+begin_src emacs-lisp - (defun jao-gnus-follow-link (&optional external) - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (gnus-summary-select-article-buffer)) - (save-excursion - (goto-char (point-min)) - (when (or (search-forward-regexp "^Via: h" nil t) - (search-forward-regexp "^URL: h" nil t) - (and (search-forward-regexp "^Link$" nil t) - (not (beginning-of-line)))) - (if external - (jao-browse-with-external-browser) - (browse-url (jao-url-around-point)))))) - - (defun jao-gnus-open-enclosure () - (interactive) - (save-window-excursion - (gnus-summary-select-article-buffer) - (save-excursion - (goto-char (point-min)) - (when (search-forward "Enclosure:") - (forward-char 2) - (when-let ((url (thing-at-point-url-at-point))) - (jao-browse-add-url-to-mpc url)))))) - #+end_src -* Add-ons -*** notmuch integration - #+begin_src emacs-lisp - (require 'jao-notmuch-gnus) - - (jao-notmuch-gnus-auto-tag) - - (defun jao-gnus-toggle-todo () - (interactive) - (jao-notmuch-gnus-toggle-tags '("todo"))) - - (define-key gnus-summary-mode-map (kbd "C-c T") #'jao-notmuch-gnus-tag-message) - (define-key gnus-summary-mode-map (kbd "C-c t") #'jao-notmuch-gnus-show-tags) - (define-key gnus-summary-mode-map (kbd "C-c C-t") #'jao-gnus-toggle-todo) - - (with-eval-after-load "notmuch-show" - (define-key gnus-group-mode-map "z" #'jao-gnus-consult-notmuch) - (define-key gnus-group-mode-map "Z" #'notmuch) - (define-key notmuch-show-mode-map - (kbd "C-c C-c") - #'jao-notmuch-gnus-goto-message)) - - (defun jao-gnus-notmuch-export (query) - (notmuch-tree query nil nil "* consult-notmuch results *")) - - (setq consult-notmuch-export-function #'jao-gnus-notmuch-export) - - (with-eval-after-load "notmuch-tree" - (define-key notmuch-tree-mode-map - (kbd "C-<return>") - #'jao-notmuch-gnus-goto-message)) - - #+end_src -*** gnus-icalendar - #+begin_src emacs-lisp - (require 'ol-gnus) - (use-package gnus-icalendar - :demand t - :init (setq gnus-icalendar-org-capture-file - (expand-file-name "inbox.org" org-directory) - gnus-icalendar-org-capture-headline '("Appointments")) - :config (gnus-icalendar-org-setup)) - #+end_src -*** bbdb - #+begin_src emacs-lisp - (with-eval-after-load "bbdb" - (bbdb-initialize 'gnus 'message 'pgp 'mail) - (bbdb-mua-auto-update-init 'gnus) - (with-eval-after-load "gnus-sum" - (define-key gnus-summary-mode-map ":" 'bbdb-mua-annotate-sender) - (define-key gnus-summary-mode-map ";" 'bbdb-mua-annotate-recipients))) - #+end_src -*** randomsig - #+begin_src emacs-lisp - (with-eval-after-load "randomsig" - (with-eval-after-load "gnus-sum" - (define-key gnus-summary-save-map "-" 'gnus/randomsig-summary-read-sig))) - #+end_src -* Keyboard shortcuts - #+begin_src emacs-lisp - (define-key gnus-article-mode-map "i" 'jao-gnus-show-images) - (define-key gnus-summary-mode-map "i" 'jao-gnus-show-images) - (define-key gnus-article-mode-map "\M-g" 'jao-gnus-follow-link) - (define-key gnus-summary-mode-map "\M-g" 'jao-gnus-follow-link) - (define-key gnus-summary-mode-map "v" 'scroll-other-window) - (define-key gnus-summary-mode-map "V" 'scroll-other-window-down) - (define-key gnus-summary-mode-map "X" 'jao-gnus-arXiv-capture) - (define-key gnus-summary-mode-map "e" 'jao-gnus-open-enclosure) - (define-key gnus-summary-mode-map "\C-l" nil) - - #+end_src @@ -0,0 +1,3393 @@ +;; -*- lexical-binding: t; -*- + +;;; Initialisation +;;;; Bootstrap and use package +(defvar jao-emacs-dir (expand-file-name "~/etc/emacs")) + +(setq package-user-dir + (expand-file-name (format "~/.emacs.d/elpa.%s" emacs-major-version)) + package-check-signature 'allow-unsigned) + +(require 'package) +(setq package-archives + '(("gnu-devel" . "https://elpa.gnu.org/devel/") + ("nongnu-devel" . "https://elpa.nongnu.org/nongnu-devel/") + ("melpa" . "https://melpa.org/packages/")) + package-archive-priorities '(("gnu-devel" . 2) + ("nongnu-devel" . 1) + ("melpa" . 0))) + +(package-initialize) + +(unless (package-installed-p 'use-package) + (package-refresh-contents) + (package-install 'use-package)) +(require 'use-package) + +(use-package gnu-elpa-keyring-update :ensure t) + +;;;; .elc vs .el loading + +(setq load-prefer-newer t) +(setq comp-async-report-warnings-errors nil + warning-suppress-types '((comp))) + +;;; Paths +(defvar jao-local-lisp-dir "~/lib/elisp" + "Directory for external elisp libraries and repos") + +(defvar jao-data-dir (expand-file-name "data" jao-emacs-dir) + "Directory containing static data, such as images.") + +(defun jao-data-file (file) (expand-file-name file jao-data-dir)) + +(setq jao-org-dir (expand-file-name "~/doc/org")) + +(defvar jao-sink-dir + (file-name-as-directory (expand-file-name "~/doc/sink")) + "Directory used for downloads and such.") + +(defvar jao-site-dir (expand-file-name "site" jao-emacs-dir)) +(defun jao-site-el (basename &optional gpg) + (expand-file-name (concat basename ".el" (when gpg ".gpg")) jao-site-dir)) + +(defun jao-load-site-el (basename &optional gpg) + (let ((lf (jao-site-el basename gpg))) + (if (file-exists-p lf) + (load lf) + (message "Attempted to load non existing %s" lf)))) + +(defun jao-exec-path (dir) + (let ((fn (expand-file-name dir))) + (add-to-list 'exec-path fn nil) + (setenv "PATH" (concat fn ":" (getenv "PATH"))))) + +(defun jao-load-path (subdir) + "Add to load path a subdir of `jao-local-lisp-dir'" + (let ((path (expand-file-name subdir jao-local-lisp-dir))) + (when (file-directory-p path) (add-to-list 'load-path path)))) + +;;;; load and info path initialisation +(add-to-list 'load-path jao-site-dir) +(add-to-list 'load-path jao-local-lisp-dir) +(add-to-list 'load-path (expand-file-name "custom" jao-emacs-dir)) +(add-to-list 'load-path "/usr/local/share/emacs/site-lisp/") + +(let ((libd (expand-file-name "lib" jao-emacs-dir))) + (add-to-list 'load-path libd) + (dolist (f (directory-files libd t "^[^.]+$")) + (when (file-directory-p f) (add-to-list 'load-path f)))) + +(defvar jao-info-dir (expand-file-name "~/doc/info")) +(require 'info) +(add-to-list 'Info-directory-list jao-info-dir) + +;;;; custom location of custom.el and co. +(setq custom-file (jao-site-el "custom")) +(load custom-file) +(setq custom-unlispify-tag-names nil) +(setq custom-buffer-done-kill t) +(setq custom-raised-buttons nil) + +;;; Preamble +;;;; preamble (pre.el) +(jao-load-site-el "pre") + +;;; System Utilities +;;;; persist +(require 'persist) + +;;;; (no) backups +(setq vc-make-backup-files nil + make-backup-files nil) + +;;;; history (saveplace, recentf, savehist) +(require 'saveplace) +(setq save-place-file (expand-file-name "~/.emacs.d/cache/places")) +(save-place-mode 1) + +(setq recentf-save-file (expand-file-name "~/.emacs.d/cache/recentf") + recentf-max-saved-items 2000 + recentf-exclude '("/home/jao/\\.emacs\\.d/elpa.*/.*" + ".*/.git/COMMIT_EDITMSG")) + +(require 'recentf) +(recentf-mode 1) + + +(setq savehist-file (expand-file-name "~/.emacs.d/cache/history")) +(require 'savehist) + +(savehist-mode t) + +(defun jao-unpropertize-kill-ring () + (setq kill-ring (mapcar #'substring-no-properties kill-ring))) + +(add-hook 'kill-emacs-hook #'jao-unpropertize-kill-ring) + +(setq savehist-additional-variables '(kill-ring search-ring regexp-search-ring) + savehist-ignored-variables '(ido-file-history)) + +;;;; yes/no, bell, startup message + +(setq use-short-answers t) +(setq inhibit-startup-message t) +(setq visible-bell t) + +;;;; server +(setenv "EDITOR" "emacsclient") +(require 'server) +(unless (or (daemonp) (server-running-p)) (server-start)) + +;;;; timers +(put 'list-timers 'disabled nil) + +;;;; tramp +(inhibit-remote-files) + +;;;; sleep/awake +(use-package jao-sleep) +(jao-sleep-dbus-register) + +;;;; process runners +(use-package jao-shell + :demand t + :config (jao-shell-def-exec jao-trayer "trayer.sh") + :bind (("s-r" . jao-shell-exec))) + +;;;; app launcher +(jao-load-path "app-launcher") +(use-package app-launcher + :bind (("s-R" . app-launcher-run-app))) + +;;;; brightness control +(jao-shell-def-exec jao-bright-set-up "brightnessctl" "-q" "s" "5%+") +(jao-shell-def-exec jao-bright-set-down "brightnessctl" "-q" "s" "5%-") + +(defun jao-brightness () + (string-trim (or (cadr (jao-shell-cmd-lines "brightnessctl")) "(Unknown)"))) + +(defun jao-bright-show () + (interactive) + (message "%s" (jao-brightness))) + +(defun jao-bright-up () + (interactive) + (jao-shell-exec "brightnessctl -q s 5%%+" t) + (jao-bright-show)) + +(defun jao-bright-down () + (interactive) + (jao-shell-exec "brightnessctl -q s 5%%-" t) + (jao-bright-show)) + +;;;; keyboard +(when (> emacs-major-version 27) + (use-package repeat + :config (setq repeat-echo-function 'repeat-echo-mode-line + repeat-exit-key "SHIFT" + repeat-exit-timeout 2)) + (repeat-mode)) + +(defun jao-kb-toggle (&optional lyt) + (interactive) + (shell-command-to-string (or lyt + (if (jao-kb-toggled-p) + "setxkbmap us" + "setxkbmap us -variant intl")))) + +(defun jao-kb-toggled-p () + (not (string-empty-p + (shell-command-to-string "setxkbmap -query|grep variant")))) + +(customize-set-variable 'default-input-method "catalan-prefix") +;; http://mbork.pl/2022-03-07_Transient_input_method +(customize-set-variable 'default-transient-input-method "TeX") + +(setq echo-keystrokes 1 + suggest-key-bindings nil) + +;;;; transient +(use-package transient + :init (setq transient-show-popup t) ;; 2.0 + :demand t + :config + (transient-bind-q-to-quit)) + +(defmacro jao-transient-major-mode (mode &rest suffix) + (declare (indent defun)) + (let ((mode (intern (format "%s-mode" mode))) + (mmap (intern (format "%s-mode-map" mode))) + (name (intern (format "jao-transient-%s" mode)))) + `(progn + (transient-define-prefix ,name () + ,(format "Transient ops for %s" mode) + [,(format "Operations for %s" mode) :if-derived ',mode ,@suffix]) + (define-key ,mmap (kbd "s-SPC") #',name) + (define-key ,mmap (kbd "C-c SPC") #',name)))) + +(defmacro jao-transient-major-mode+1 (mode suffix) + (declare (indent defun)) + (let ((name (intern (format "jao-transient-%s" mode)))) + (if (fboundp name) + `(transient-append-suffix ',name '(0 -1) ,suffix) + `(jao-transient-major-mode ,mode ,suffix)))) + +(defmacro jao-transient-major-mode+ (mode &rest suffixes) + (declare (indent defun)) + `(progn ,@(mapcar (lambda (s) `(jao-transient-major-mode+1 ,mode ,s)) + suffixes))) + +;;;; disk monitoring +(use-package jao-dirmon + :commands jao-dirmon-report) +;;;; mailcap +(use-package mailcap + :config + (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg")) + (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg")) + + (defun jao-icalendar-import-buffer (&optional no-kill) + (let ((icalendar-import-format "%s%u%l%d")) + (icalendar-import-buffer diary-file t nil)) + (unless no-kill (kill-buffer)) + (message "Event imported into diary")) + + (defun jao-icalendar-import-invite (file) + (with-temp-buffer + (insert-file-contents file) + (jao-icalendar-import-buffer t))) + + :custom + ((mailcap-user-mime-data + `((jao-icalendar-import-buffer "application/ics") + ("emacsclient -e '(jao-icalendar-import-invite \"%s\")'" "application/ics") + (doc-view-mode "application/.*pdf" (display-graphic-p)) + ("zathura \"%s\"" "application/.*pdf") + (image-mode "image/.*" (display-graphic-p)) + ("firefox %s && riverctl set-focused-tags 2" "text/html" jao-river-enabled) + ("swayimg \"%s\"" "image/.*" jao-sway-enabled) + ("imv-wayland \"%s\"" "image/.*" jao-wayland-enabled) + ("imv-x11 \"%s\"" "image/.*"))))) + +;;; Crypto +;;;; PGP, EPG, passwords +(setq auth-source-debug nil) + +(require 'auth-source) +(add-to-list 'auth-source-protocols '(local "local")) +(setq auth-sources '("~/.emacs.d/authinfo.gpg" "~/.netrc")) + +(use-package epa-file + :init (setq epa-file-cache-passphrase-for-symmetric-encryption t + epa-file-encrypt-to "A247C4780736A6156BC8DA748C081D34D321D881" + plstore-encrypt-to epa-file-encrypt-to) + :config (epa-file-enable)) +(require 'epa-file) + +(defun jao--get-user/password (h) + (let ((item (car (auth-source-search :type 'netrc :host h :max 1)))) + (when item + (let ((user (plist-get item :user)) + (pwd (plist-get item :secret))) + (list user (when pwd (funcall pwd))))))) + +(defun jao-call-with-auth (host fun) + (let ((up (jao--get-user/password host))) + (funcall fun (car up) (cadr up)))) + +(defmacro jao-with-auth (host usr pwd &rest body) + (declare (indent defun)) + `(jao-call-with-auth ,host (lambda (,usr ,pwd) ,@body))) + +;;;; pass +(use-package password-store-menu + :ensure t + :config (password-store-menu-enable) + :custom (password-store-menu-key "C-c p")) + +;;; Fonts and color themes +;;;; widgets +(setq widget-image-enable nil + widget-link-prefix "" + widget-link-suffix "" + widget-button-prefix " " + widget-button-suffix " " + widget-push-button-prefix "" + widget-push-button-suffix "") + +;;;; nobreak char display +(setq nobreak-char-display nil) + +;;;; vertical separator +(unless (display-graphic-p) + (set-display-table-slot standard-display-table + 'vertical-border + (make-glyph-code ?│))) + +;;;; transparency +(defvar jao-transparent-only-bg (> emacs-major-version 28)) + +(defvar jao-frames-default-alpha + (cond ((eq window-system 'pgtk) 85) + (jao-transparent-only-bg 88) + (t 85))) + +(defvar jao-transparent-frame (< jao-frames-default-alpha 100)) + +(defun jao-alpha-parameters (&optional level) + (let ((level (or level jao-frames-default-alpha))) + (if jao-transparent-only-bg + `((alpha-background . ,level) (alpha)) + `((alpha . ,(cons level level)) (alpha-background))))) + +(defun jao-set-transparency (&optional level all) + (interactive "nOpacity (0-100): ") + (let ((level (or level jao-frames-default-alpha))) + (setq jao-transparent-frame (< level 100)) + (if all + (modify-all-frames-parameters (jao-alpha-parameters level)) + (modify-frame-parameters nil (jao-alpha-parameters level))))) + +(defun jao-toggle-transparency (&optional all) + (interactive "P") + (let ((level (if jao-transparent-frame 100 jao-frames-default-alpha))) + (jao-set-transparency level all))) + +(jao-set-transparency) + +;;;; themes +(defun jao-colors-scheme-dark-p () + (equal "dark" (getenv "JAO_COLOR_SCHEME"))) + +(defun jao-colors-scheme () + (if (jao-colors-scheme-dark-p) 'dark 'light)) + +(customize-set-variable 'frame-background-mode (jao-colors-scheme)) + +(setq custom-theme-directory + (expand-file-name "lib/themes" jao-emacs-dir)) + +(require 'jao-themes) + +(defvar jao-theme-dark 'jao-dark) +(defvar jao-theme-light 'jao-light) +(defvar jao-theme-term-dark 'modus-vivendi) +(defvar jao-theme-term-light 'jao-light-term) + +(defun jao-themes-setup () + (let* ((dark (jao-colors-scheme-dark-p)) + (theme (cond ((and dark window-system) jao-theme-dark) + (dark jao-theme-term-dark) + (window-system jao-theme-light) + (t jao-theme-term-light)))) + (load-theme theme t) + (modify-all-frames-parameters `((font . ,jao-themes-default-face))))) + +(jao-themes-setup) + +;;; Help system +;;;; help buffers +(setq help-window-select t + help-window-keep-selected nil + help-link-key-to-documentation t) + +;;;; find-func/var/lib +(use-package find-func + :bind (("C-h C-v" . find-variable) + ("C-h C-f" . find-function) + ("C-h C-k" . find-function-on-key) + ("C-h C-l" . find-library))) + +;;;; eldoc +(use-package eldoc + :init (setq eldoc-minor-mode-string nil + eldoc-idle-delay 0.1 + eldoc-echo-area-display-truncation-message nil + eldoc-echo-area-use-multiline-p 5 + eldoc-echo-area-prefer-doc-buffer 'maybe + eldoc-display-functions '(eldoc-display-in-echo-area)) + :config (global-eldoc-mode 1)) + +(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)))) + +;;;; bookmarks +(setq bookmark-default-file "~/.emacs.d/emacs.bmk" + bookmark-fringe-mark nil) + +;;;; man pages +(use-package man + :config (setq Man-notify-method 'pushy)) ;; pushy - same window + +;;; Minibuffer +(use-package jao-minibuffer + :init + (if (jao-colors-scheme-dark-p) + (setq jao-minibuffer-active-buffer-line-color "azure4" + jao-minibuffer-inactive-buffer-line-color "grey25") + (setq jao-minibuffer-active-buffer-line-color "burlywood3" + jao-minibuffer-inactive-buffer-line-color "grey65")) + (setq jao-minibuffer-adaptive-alignment nil) + :commands (jao-minibuffer-add-variable + jao-minibuffer-refresh + jao-minibuffer-mode)) + +(setq enable-recursive-minibuffers t) +(require 'mb-depth) +(minibuffer-depth-indicate-mode 1) + +(setq minibuffer-default-prompt-format " (default %s)") +(minibuffer-electric-default-mode 1) + +(jao-minibuffer-mode 1) + +;;; Mode line +;;;; config +(setq line-number-display-limit-width 250 + mode-line-position-column-format '(" %c") + mode-line-position-line-format '(" %c %l") + mode-line-end-spaces nil + mode-line-percent-position + '("%2l" (:eval (format " %d " (line-number-at-pos (point-max)))) "%2c")) + +(line-number-mode -1) +(column-number-mode -1) + +;;;; jao-mode-line +(defvar jao-mode-line-in-minibuffer t) + +(use-package jao-mode-line + :commands (jao-mode-line-add-to-minibuffer-left + jao-mode-line-add-to-minibuffer-right + jao-mode-line-remove-from-minibuffer)) + +;;;; time display +(setq world-clock-list + '(("Europe/London" "Edinburgh") + ("Europe/Paris" "Barcelona") + ("Asia/Tokyo" "Tokyo") + ("America/Los_Angeles" "Corvallis") + ("America/New_York" "New York"))) + +(setq display-time-day-and-date nil + display-time-24hr-format nil + display-time-default-load-average nil + display-time-format " %a %e %H:%M") + +(defun jao-time-to-epoch (&optional s) + "Transform a time string to an epoch integer in milliseconds." + (interactive) + (let ((s (or s (read-string "Time string: " (thing-at-point 'string))))) + (message "%s = %s" + s + (round (* 1000 (time-to-seconds (parse-time-string s))))))) + +(defun jao-epoch-to-time (&optional v) + "Transform an epoch, given in milliseconds, to a time string." + (interactive) + (let ((v (or v (read-number "Milliseconds: " (thing-at-point 'number))))) + (message "%s = %s" v + (format-time-string "%Y-%m-%d %H:%M:%S" + (seconds-to-time (/ v 1000.0)))))) + +;;;; mode line toggle +(use-package jao-mode-line + :init + (when (and window-system (not jao-mode-line-in-minibuffer)) + (add-to-list 'after-make-frame-functions #'jao-mode-line-hide-inactive) + (add-hook 'after-init-hook #'jao-mode-line-toggle-inactive)) + :demand t + :bind (("<home>" . jao-mode-line-toggle-inactive) + ("<end>" . jao-mode-line-toggle) + ("<insert>" . jao-mode-line-echo))) + +;;;; diminish +(use-package diminish + :ensure t + :demand t + :diminish ((auto-fill-function . " §") + (auto-revert-mode . ""))) + +(use-package outline + :diminish ((outline-minor-mode . ""))) + +;;;; battery +(use-package battery + :init (setq battery-load-low 15 + battery-load-critical 8 + battery-mode-line-limit 40 + battery-echo-area-format + "%L %r %B (%p%% load, remaining time %t)" + battery-mode-line-format " 🔋%b%p% ")) + +(with-eval-after-load "jao-minibuffer" + (if jao-mode-line-in-minibuffer + (display-battery-mode 1) + (jao-minibuffer-add-variable 'battery-mode-line-string 80))) + +;;; Notifications +;;;; jao-notify +(use-package jao-notify + :demand t + :init (setq jao-notify-use-messages t)) + +;;;; tracking +(use-package tracking + :demand t + :init (setq tracking-position 'before-modes + tracking-frame-behavior nil + tracking-most-recent-first nil + tracking-max-mode-line-entries 10 + tracking-sort-faces-first t + tracking-shorten-modes '()) + :config + (setq erc-track-enable-keybindings nil)) + +(use-package jao-tracking + :demand t + :init (setq jao-tracking-bkg (if (jao-colors-scheme-dark-p) "grey20" "grey93")) + :config (jao-tracking-setup t)) + +;;;; ednc + +(use-package ednc + :ensure t + :diminish nil) + +(use-package jao-ednc + :demand t + :init (setq jao-ednc-use-tracking nil) + :commands (jao-ednc-setup) + :after ednc + :config + (jao-ednc-ignore-app "Firefox") + (transient-define-prefix jao-transient-ednc () + ["Notifications" + ("s" "show last" jao-ednc-show) + ("S" "show all" jao-ednc-pop) + ("n" "dismiss and show" jao-ednc-dismiss-and-show :transient t) + ("d" "dismiss last" jao-ednc-dismiss) + ("D" "dismiss all" jao-ednc-dismiss-all) + ("i" "invoke last action" jao-ednc-invoke-last-action)]) + (global-set-key (kbd "s-n") #'jao-transient-ednc)) + +;;; Calendar, diary, weather +;;;; diary +(setq diary-file (expand-file-name "diary" jao-org-dir) + diary-display-function 'diary-fancy-display + diary-mail-addr "jao@localhost" + diary-comment-start ";;" + diary-comment-end "") + +(add-hook 'diary-list-entries-hook 'diary-sort-entries t) + +;;;; calendar +(setq appt-display-format nil) +(appt-activate 1) +(setq calendar-latitude 55.9533 + calendar-longitude -3.1883 + calendar-left-margin 4 + calendar-location-name "Edinburgh, Scotland" + calendar-mark-diary-entries-flag t + calendar-week-start-day 1 ;; 0 sunday + calendar-date-echo-text '(format "ISO date: %s" + (calendar-iso-date-string + (list month day year)))) + +(setq calendar-holidays + '((holiday-fixed 1 1 "New Year's Day") + (holiday-fixed 4 1 "April Fools' Day") + (holiday-float 5 0 2 "Mother's Day") + (holiday-fixed 3 19 "Father's Day") + (holiday-float 11 4 4 "Thanksgiving") + (holiday-fixed 12 25 "Christmas") + (holiday-chinese-new-year) + (solar-equinoxes-solstices) + (holiday-sexp calendar-daylight-savings-starts + (format "Daylight Saving Time Begins %s" + (solar-time-string + (/ calendar-daylight-savings-starts-time + (float 60)) + calendar-standard-time-zone-name))) + (holiday-sexp calendar-daylight-savings-ends + (format "Daylight Saving Time Ends %s" + (solar-time-string + (/ calendar-daylight-savings-ends-time + (float 60)) + calendar-daylight-time-zone-name))))) + +(add-to-list 'display-buffer-alist + `(,(regexp-quote diary-fancy-buffer) + (display-buffer-at-bottom) + (window-parameters (mode-line-format . none)) + (window-height . fit-window-to-buffer))) + +(defun jao-diary--select () + (switch-to-buffer diary-fancy-buffer)) + +(add-hook 'diary-fancy-display-mode-hook #'jao-diary--select) +(setq org-calendar-insert-diary-entry-key nil + org-agenda-diary-file 'diary-file) + +;;;; winttr +(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*")))) +(global-set-key (kbd "<f5>") #'jao-weather) + +;;; Files, dired and scratch buffer +;;;; so-long +(setq large-file-warning-threshold (* 200 1024 1024)) + +;; (use-package so-long +;; :ensure t +;; :diminish) +;; (global-so-long-mode 1) + +;;;; persistent scratch +(use-package persistent-scratch + :ensure t + :config (persistent-scratch-setup-default)) + +;;;; dired +(use-package dired + :init + (setq dired-recursive-deletes 'top + dired-recursive-copies 'top + dired-listing-switches "-alhF --group-directories-first" + ls-lisp-dirs-first t + dired-dwim-target t + dired-kill-when-opening-new-dired-buffer t + dired-mouse-drag-files t + wdired-create-parent-directories t + dired-guess-shell-alist-user + '(;; ("\\.\\(png\\|jpe?g\\|tiff\\)" "feh" "xdg-open") + ("\\.\\(mp[34]\\|m4a\\|ogg\\|flac\\|webm\\|mkv\\)" "mpv" "xdg-open") + (".*" "xdg-open"))) + + (put 'dired-find-alternate-file 'disabled nil) + :hook (dired-mode . turn-on-gnus-dired-mode) + :bind (:map dired-mode-map + ("C-c C-r" . wdired-change-to-wdired-mode) + ("C-M-m" . gnus-dired-attach))) + +(use-package dired-x :demand t) + +(use-package find-dired + :init (setq find-ls-option '("-print0 | xargs -0 ls -ld" . "-ld")) + :bind ("C-c D" . find-name-dired)) + +(use-package dired-duplicates :ensure t) + +;;; General editing +;;;; automatically uncompress +(require 'jka-compr) +(auto-compression-mode 1) + +;;;; wgrep +(use-package wgrep :ensure t) +(require 'wgrep) + +;;;; executable scripts +(add-hook 'after-save-hook + 'executable-make-buffer-file-executable-if-script-p) + +;;;; spaces, tabs, kill +(setq kill-whole-line t) +(setq-default indent-tabs-mode nil) +(setq indent-tabs-width 4) +(setq-default default-tab-width 8) +(setq kill-read-only-ok t) +(setq view-read-only nil) + +;;;; whitespace and filling column +(add-hook 'write-file-functions 'delete-trailing-whitespace) +(setq-default indicate-empty-lines nil) +(setq-default fill-column 78) +(setq comment-auto-fill-only-comments nil) + +(use-package whitespace + :init + (setq whitespace-style '(face tabs trailing ;; lines-tail + empty missing-newline-at-eof) + whitespace-line-column 80) + :hook (prog-mode . whitespace-mode) + :diminish nil) + +(use-package display-fill-column-indicator + :init (setq-default display-fill-column-indicator-column 80) + :hook (prog-mode . display-fill-column-indicator-mode)) + +;;;; visible mode +(use-package visible-mode + :bind (("s-v" . visible-mode))) + +;;;; changes +(use-package goto-chg + :ensure t + :bind (("C-." . goto-last-change) + ("C-c ." . goto-last-change) + ("C-c ," . goto-last-change-reverse))) + +;;;; eval-and-replace +(defun fc-eval-and-replace () + "Replace the preceding sexp with its value." + (interactive) + (backward-kill-sexp) + (condition-case nil + (prin1 (eval (read (current-kill 0))) + (current-buffer)) + (error (message "Invalid expression") + (insert (current-kill 0))))) + + (global-set-key "\C-ce" 'fc-eval-and-replace) + +;;;; skeletons and autoinsert +(use-package autoinsert + :config + (setq auto-insert-directory "~/.emacs.d/autoinsert/" + auto-insert t + auto-insert-query t) + (setf (alist-get 'html-mode auto-insert-alist nil t) nil)) +(add-hook 'find-file-hook #'auto-insert) + +(use-package jao-skel + :demand t + :config + (defvar flymake-allowed-file-name-masks nil) + (require 'jao-skel-geiser) + (require 'jao-skel-lisp) + (require 'jao-skel-haskell) + (require 'jao-skel-latex)) + +;;; Completion and search +;;;; completion +(require 'jao-custom-completion) + +;;;; recoll +(jao-load-path "consult-recoll") + +(defun jao-recoll-format (title url _mtype) + (let* ((u (replace-regexp-in-string "file://" "" url)) + (u (replace-regexp-in-string "/home/jao/" "" u)) + (u (replace-regexp-in-string + "\\(doc\\|org/doc\\|.emacs.d/gnus/Mail\\|var/mail\\)/" "" u))) + (format "%s (%s)" ;; "%s (%s, %s)" + title + (propertize u 'face 'jao-themes-f01) + ;; (propertize mtype 'face 'jao-themes-f01) + ))) + +(defun jao-recoll-open-html (file &optional _page) + (if (string-match-p "\.epub\\'" file) + (find-file file) + (jao-afio-goto-www) + (if jao-afio-use-w3m (w3m-find-file file) (eww-open-file file)))) + +(defun jao-recoll-open-pdf (file &optional page) + (if (string-match-p "/gnus/Mail/" file) + (funcall (or (cdr (assoc-string "message/rfc822" consult-recoll-open-fns)) + 'find-file) + file + page) + (jao-open-doc file page))) + +(defun jao-recoll-consult-messages () + (interactive) + (consult-recoll "mime:message ")) + +(defun jao-recoll-consult-docs () + (interactive) + (consult-recoll (format "dir:%s/doc " jao-org-dir))) + +(defun jao-recoll-consult-notes () + "Use consult-recoll to search notes." + (interactive) + (consult-recoll (format "dir:%s " jao-org-notes-dir))) + +(use-package consult-recoll + :commands (consult-recoll consult-recoll-embark-setup) + :init (setq consult-recoll-open-fns + '(("application/pdf" . jao-recoll-open-pdf) + ("text/html" . jao-recoll-open-html)) + consult-recoll-search-flags 'query + consult-recoll-inline-snippets t + consult-recoll-format-candidate #'jao-recoll-format) + :config + (consult-customize consult-recoll :preview-key 'any) + + (transient-define-prefix jao-transient-recoll () + ["Consult recoll queries" + ("r" "everywhere" consult-recoll) + ("n" "on notes" jao-recoll-consult-notes) + ("d" "on docs" jao-recoll-consult-docs) + ("m" "on messages" jao-recoll-consult-messages)]) + + :bind (("s-r" . #'jao-transient-recoll))) + +(with-eval-after-load "embark" (consult-recoll-embark-setup)) + +;;; Buffers +;;;; cursor and mark +(transient-mark-mode -1) +(blink-cursor-mode -1) +(setopt cursor-in-non-selected-windows nil + visible-cursor nil) ;; stop blinking in xterm + +;;;; uniquifiy +(require 'uniquify) +(setq uniquify-buffer-name-style 'forward + uniquify-trailing-separator-p t) + +;;;; autosave +(setq auto-save-list-file-prefix "~/.emacs.d/auto-save-list/.saves-" + auto-save-no-message t + kill-buffer-delete-auto-save-files t) + +(setq lock-file-name-transforms + '(("\\`/.*/\\([^/]+\\)\\'" "/tmp/emacs-lock/\\1" t))) + +;;;; autorevert +(setq auto-revert-check-vc-info nil) +(setq auto-revert-verbose nil) +(setq auto-revert-avoid-polling t) +(setq auto-revert-mode-text "") +(require 'autorevert) +(global-auto-revert-mode 1) + +;;;; attached buffers +(defun jao-display-buffer-below-selected (buffer alist) + (delete-other-windows-vertically) + (display-buffer-below-selected buffer alist)) + +(defun jao-attached-buffer-entry (name-rx height) + `(,name-rx (display-buffer-reuse-window + jao-display-buffer-below-selected) + (window-height . ,(or height 25)))) + +(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)) + +(defun jao-define-attached-buffer (name-rx &optional height) + (add-to-list 'display-buffer-alist + (jao-attached-buffer-entry name-rx height))) + +(jao-define-attached-buffer "\\*eldoc\\( .*\\)?\\*" 0.33) + +;;;; same mode +(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)))) + +(defun jao-buffer-same-mode-cmd (&optional pop) + (interactive "P") + (jao-buffer-same-mode nil nil (and pop #'pop-to-buffer))) + +(global-set-key (kbd "C-c C-b") #'jao-buffer-same-mode-cmd) + +;;;; projects +(use-package project :demand t) +(global-set-key "\C-xp" 'jao-prev-window) +(use-package list-projects :ensure t) + +;;;; buffer quit function (the triple ESC) +(setq buffer-quit-function (lambda () t)) + + +;;;; redisplay escape hatch +;; (setq max-redisplay-ticks 2250000) +;;;; scrolling +(if window-system + (setq scroll-preserve-screen-position 'always + scroll-conservatively most-positive-fixnum + scroll-margin 0 + scroll-step 2 + redisplay-skip-fontification-on-input t) + (setq scroll-preserve-screen-position nil + scroll-conservatively 0 + scroll-margin 0 + scroll-step 1 + redisplay-skip-fontification-on-input nil)) + +(use-package ultra-scroll + ;:load-path "~/code/emacs/ultra-scroll" ; if you git clone'd instead of using vc + :vc (:url "https://github.com/jdtsmith/ultra-scroll") ; For Emacs>=30 + :init + (setq scroll-conservatively 3 ; or whatever value you prefer, since v0.4 + scroll-margin 0) ; important: scroll-margin>0 not yet supported + :config + (ultra-scroll-mode 1)) + +;;;; show diffs when running C-x s +(add-to-list 'save-some-buffers-action-alist + `("d" + ,(lambda (buffer) + (diff-buffer-with-file (buffer-file-name buffer))) + "show diff between the buffer and its file")) + +;;;; copy buffer file name +;; https://stackoverflow.com/questions/18812938/copy-full-file-path-into-copy-paste-clipboard +(defun copy-buffer-file-name-as-kill (choice) + "Copy the buffer-file-name to the kill-ring" + (interactive "cCopy Buffer Name (F) Full, (D) Directory, (N) Name") + (let ((new-kill-string) + (name (if (eq major-mode 'dired-mode) + (dired-get-filename) + (or (buffer-file-name) "")))) + (cond ((eq choice ?f) + (setq new-kill-string name)) + ((eq choice ?d) + (setq new-kill-string (file-name-directory name))) + ((eq choice ?n) + (setq new-kill-string (file-name-nondirectory name))) + (t (message "Quit"))) + (when new-kill-string + (message "%s copied" new-kill-string) + (kill-new new-kill-string)))) + +;;; Windows +;;;; splitting and switch +(setq split-height-threshold 80 + split-width-threshold 144 + display-buffer-avoid-small-windows 20) + +(setq switch-to-buffer-preserve-window-point nil + switch-to-buffer-obey-display-actions t + switch-to-prev-buffer-skip 'this) ;; don't switch to a + ;; buffer already visible in + ;; this frame + +(global-set-key (kbd "C-x _") #'delete-other-windows-vertically) + +;;;; first window +(defvar jao-first-window--from nil) + +(defun jao-first-window () + "Go to previous windows in frame, remembering where we were." + (interactive) + (let ((cb (current-buffer))) + (if (eq (get-buffer-window cb) (select-window (frame-first-window))) + (when jao-first-window--from (pop-to-buffer jao-first-window--from)) + (setq jao-first-window--from cb)))) + +(global-set-key (kbd "s-a") #'jao-first-window) +(global-set-key (kbd "M-a") #'jao-first-window) + +;;;; window navigation (custom) +(defun jao-nth-window (n) + (if (zerop n) + 'jao-first-window + `(lambda () + (interactive) + (select-window (frame-first-window)) + (dotimes (x ,n) (other-window 1))))) + +(defun jao-prev-window () + "Go to previous window." + (interactive) + (other-window -1)) + +(defvar jao-prev-window-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "p" 'jao-prev-window) + (define-key map "P" (lambda () + (interactive) + (setq repeat-map 'jao-prev-window-repeat-map) + (other-window 1))) + map) + "Keymap to repeat `prev-window' key sequences. Used in `repeat-mode'.") + +(put 'jao-prev-window 'repeat-map jao-prev-window-repeat-map) + +(mapc (lambda (n) + (global-set-key (format "\C-c%s" (1+ n)) (jao-nth-window n))) + '(0 1 2 3 4 5 6 7 8)) + +;; transposing windows +(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)))))) + +(define-key ctl-x-4-map (kbd "t") 'transpose-windows) + +;;;; winner mode +(winner-mode 1) + +;;; Frames +;;;; frame geometry +(setq frame-resize-pixelwise t) +(modify-all-frames-parameters + `((horizontal-scroll-bars . nil) + (vertical-scroll-bars . nil) + (scroll-bar-width . 0) + (menu-bar . nil))) + +;;;; frame layout, title, etc +(setq frame-title-format '("%b - emacs")) +(use-package fringe) +(fringe-mode) + +(menu-bar-mode -1) + +;; (setting it to nil avoids mouse wrapping after other-frame) +(setq focus-follows-mouse (and window-system t)) + +(use-package scroll-bar) +(set-scroll-bar-mode nil) +(use-package tool-bar) +(tool-bar-mode -1) + +(defalias 'jao-trisect 'jao-afio-trisect) + +(defun jao-bisect () + (interactive) + (jao-trisect t) + (other-window 1) + (delete-window)) + +;;;; afio +(use-package jao-afio + :demand t + :config (jao-afio-setup (not window-system)) + :bind (("C-c f" . 'jao-afio-goto-main) + ("C-c g" . 'jao-afio-goto-mail) + ("C-c w" . 'jao-afio-goto-www) + ("C-c z" . 'jao-afio-goto-docs) + ("C-c t" . 'jao-afio-goto-chats) + ("C-c 0" . 'jao-afio-goto-scratch) + ("M-o" . 'jao-afio-toggle))) +(add-hook 'jao-afio-switch-hook 'jao-minibuffer-refresh t) + +(defun jao-current--frame-id () + (propertize (cond ((and (fboundp 'jao-exwm-enabled) + (jao-exwm-enabled-p) + (not (bound-and-true-p jao-exwm--use-afio)) + (boundp 'exwm-workspace-current-index)) + (format "F%s" exwm-workspace-current-index)) + (t jao-afio-use-frames (or (jao-afio-frame-name) "")) + (t (format "%s" (or (jao-afio-frame-no) "")))) + 'face 'font-lock-warning-face)) + +(jao-minibuffer-add-variable '(jao-current--frame-id) 100) + +;;; Writing and writing modes +;;;; copyright notices +(setq copyright-year-ranges t) +(add-hook 'write-file-functions 'copyright-update) + +;;;; indent on yank +(defvar jao-auto-indent-modes + '(emacs-lisp-mode ;; clojure-mode + scheme-mode objc-mode + tuareg-mode c-mode c++-mode + tcl-mode sql-mode + perl-mode cperl-mode + java-mode jde-mode + LaTeX-mode TeX-mode)) + +(defadvice yank (after indent-region activate) + (if (member major-mode jao-auto-indent-modes) + (indent-region (region-beginning) (region-end) nil))) + +;;;; org mode +(require 'jao-custom-org) + +;;;; blog +(require 'jao-custom-blog) + +;;;; text-ish mode settings +;; SENTENCES separated by just one space +(setq sentence-end "[.?!][]\"')]*\\($\\|\t\\| \\)[ \t\n]*") +(setq sentence-end-double-space t) +;; copy rectangle +(defun kill-rectangle-save (start end) + "Save the region-rectangle as the last killed one." + (interactive "r") + (require 'rect) ; Make sure killed-rectangle is defvar'ed. + (setq killed-rectangle (extract-rectangle start end)) + (message "Rectangle saved")) + +;; text mode, autoinserts and write hooks +(setq default-major-mode 'text-mode) +(add-hook 'text-mode-hook 'turn-on-auto-fill) + +;;;; dictionaries +(use-package dictionary + :init (setq dictionary-use-single-buffer t + dictionary-server "localhost") + :commands (dictionary-search + dictionary-match-words + dictionary-lookup-definition + dictionary + dictionary-mouse-popup-matching-words + dictionary-popup-matching-words + dictionary-tooltip-mode + global-dictionary-tooltip-mode) + :bind (("C-c d" . dictionary-search))) + +(use-package ispell + :custom ((ispell-personal-dictionary + (expand-file-name "~/.emacs.d/ispell.dict")))) + +(use-package reverso + :ensure t + :init (setq reverso-languages '(english spanish french german))) + +;; (use-package wordreference +;; :ensure t +;; :init (setq wordreference-target-lang "es" +;; wordreference-source-lang "en") +;; :bind (("C-c D" . wordreference-search))) + +;;;; markdown +(use-package markdown-mode + :ensure t + :init (setq markdown-command '("pandoc" "--from=markdown" "--to=html5") + markdown-asymmetric-header t + markdown-enable-wiki-links t + markdown-wiki-link-fontify-missing t + markdown-enable-math nil ;; toggle with M-x markdown-toggle-math + markdown-link-space-sub-char "-" + markdown-gfm-additional-languages '("whizzml" "flatline") + markdown-hide-urls t + markdown-hide-markup nil + markdown-fontify-code-blocks-natively t + markdown-fontify-whole-heading-line t + markdown-unordered-list-item-prefix t) + :hook (markdown-mode . outline-minor-mode) + :config + (dolist (u '("doc" "message" "notmuch")) + (add-to-list 'markdown-uri-types u)) + (use-package markdown-toc :ensure t)) + +;; used by markdown mode to edit code blocks +(use-package edit-indirect :ensure t) + +(dolist (ext '("\\.md$" "\\.markdown$")) + (add-to-list 'auto-mode-alist (cons ext 'markdown-mode))) + +;;;; TeX and LaTex +(use-package tex-site + :ensure auctex + :init + (setq TeX-auto-save t) + (setq TeX-parse-self t) + (setq TeX-a4-paper t) + (setq TeX-auto-local ".tex-auto-local") + ;; Preferred view format: dvi, ps, pdf, pdfs + (setq TeX-view-format "pdf") + (setq-default TeX-master "../main") ; nil to ask + (setq TeX-view-program-selection + ;; '((output-dvi "open") + ;; (output-pdf "open") + ;; (output-html "open")) + '(((output-dvi has-no-display-manager) "dvi2tty") + ((output-dvi style-pstricks) "dvips and gv") + (output-dvi "xdvi") + (output-pdf "xdg-open") + (output-html "xdg-open"))) + ;; to make RefTeX faster for large documents, try these: + (setq reftex-enable-partial-scans t) + (setq reftex-save-parse-info t) + (setq reftex-use-multiple-selection-buffers t) + ;; to integrate with AUCTeX + (setq reftex-plug-into-AUCTeX t) + (setq reftex-ref-style-default-list + '("Hyperref" "Varioref" "Fancyref")) + (setq LaTeX-command "latex -shell-escape") + (setq LaTeX-biblatex-use-Biber t) + (setq bibtex-dialect 'biblatex) + :config + (add-hook 'TeX-after-compilation-finished-functions 'TeX-revert-document-buffer) + (add-hook 'LaTeX-mode-hook 'turn-on-reftex)) + +;;; Browsing +;;;; variables +(defvar jao-browse-doc-use-emacs-p t) +(defvar jao-browse-url-function nil) +(defvar jao-browse-url-external-function nil) + +;;;; url around point +(defun jao-url-around-point (&optional current-url) + (or (and (fboundp 'w3m-anchor) (w3m-anchor)) + (shr-url-at-point nil) + (ffap-url-at-point) + (thing-at-point 'url) + (when current-url + (or (and (fboundp 'w3m-anchor) (w3m-anchor)) + (and (derived-mode-p 'eww-mode) (plist-get eww-data :url)))))) + +(defun jao--url-prompt (&optional prefix) + (let* ((def (jao-url-around-point t)) + (prompt (concat prefix "URL" (if def (format " (%s): " def) ": ")))) + (read-string prompt nil nil def))) + +;;;; downloads using wget +(defun jao-wget--get-title (filename) + (or (and (derived-mode-p 'w3m-mode) (w3m-current-title)) + (plist-get eww-data :title) + (and (not (string-blank-p (or filename ""))) + (subst-char-in-string ?- ? (capitalize (file-name-base filename)))))) + +(defun jao-wget (url &optional user pwd) + "Download URL using wget and kill a link for an org note." + (let* ((def (file-name-nondirectory url)) + (pmt (format "Save %s to: " url)) + (read-file-name-function nil) + (dest (expand-file-name + (read-file-name pmt jao-sink-dir nil nil def))) + (title (jao-wget--get-title dest)) + (src-url (or (jao-url-around-point t) (file-name-directory url))) + (auth (when (and user pwd) + `(,(format "--http-user=%s" user) + ,(format "--http-password=%s" pwd)))) + (lnk (concat "doc:" (file-name-nondirectory dest)))) + (switch-to-buffer-other-window (get-buffer-create "*downloads*")) + (erase-buffer) + (kill-new (format "%s (from %s)" + (org-link-make-string lnk title) + (org-link-make-string src-url "here"))) + (apply 'make-term `("downloads" "wget" nil ,@auth "-O" ,dest ,url)))) + +(defun jao-download (url &optional pws) + "Download URL using wget" + (interactive (list (jao--url-prompt))) + (when url + (let ((usr (and pws (read-string "Login name: "))) + (pwd (and pws (read-passwd "Password: ")))) + (jao-wget url usr pwd)))) + +(with-eval-after-load "embark" + (define-key embark-url-map (kbd "d") #'jao-download)) + +;;;; video +(defvar jao-video--url-rx + (format "^https?://\\(?:www\\.\\)?%s/.+" + (regexp-opt '("youtu.be" + "youtube.com" + "blip.tv" + "vimeo.com" + "infoq.com") + t))) + +(defvar jao-video--ext-rx + (format "^https?://.+/.+\\.%s" (regexp-opt '("mp3" "webm" "mp4")))) + +(defun jao-video--url-p (url) + (or (string-match-p jao-video--url-rx url) + (string-match-p jao-video--ext-rx url))) + +(defun jao--remote-run (url prg) + (let ((args (format "%s %s" prg (shell-quote-argument url)))) + (start-process-shell-command prg nil args))) + +(defun jao--mpv (url &rest _args) (jao--remote-run url "mpv")) +(defun jao--vlc (url &rest _args) (jao--remote-run url "vlc")) + +(defvar jao--video-player 'jao--mpv) + +(defun jao-view-video (url) + "Tries to stream a video from the current or given URL" + (interactive (list (jao--url-prompt "Video "))) + (when url (funcall jao--video-player url))) + +(defun jao-maybe-view-video (url &rest _ignored) + (interactive) + (let ((w (read-char "View video (v) or web page (w)? "))) + (cond ((eq w ?v) (jao-view-video url)) + ((eq w ?w) (funcall jao-browse-url-function url)) + (t (message "Aborted"))))) + +;;;; web browsers +(defun jao-www--buffer-p (b) + (with-current-buffer b + (or (derived-mode-p 'w3m-mode 'eww-mode) + (and (boundp 'exwm-class-name) + (member exwm-class-name '("vlc" "mpv")))))) + +(require 'jao-custom-eww) +;; (require 'jao-custom-w3m) + +;;;; browse-url +(require 'browse-url) + +(setq browse-url-generic-program "~/bin/firehog") + +(defun jao-browse-with-external-browser (&rest url) + "Browse with external hogging" + (interactive "s") + (let ((url (or (car url) (jao-url-around-point)))) + (if (not url) + (message "No URL at point") + (cond ((and (jao-exwm-enabled-p) (fboundp 'jao-exwm-firefox)) + (jao-exwm-firefox)) + (jao-river-enabled (jao-river-to-ws 2)) + (jao-sway-enabled (jao-sway-firefox))) + (browse-url-generic url)))) +(setq jao-browse-url-external-function 'jao-browse-with-external-browser) + +(defun jao--fln (url) + (shell-quote-argument + (if (string-match "^[^:]*:/*?\\(/?[^/].*\\)" url) + (match-string-no-properties 1 url) + url))) + +(defun jao--browse-doc (url &rest _ignored) + (let* ((url (substring-no-properties url)) + (file (jao--fln url))) + (when file + (unless (file-exists-p file) + (error "File %s does not exist" file)) + (jao-open-doc file)))) + +(defun jao--make-file-rx (exts) + (format "file:/?/?.+\\.%s$" (regexp-opt exts))) + +(defvar jao--see-exts (jao--make-file-rx '("jpg" "jpeg" "png"))) + +(defvar jao--doc-exts + (jao--make-file-rx '("ps" "ps.gz" "pdf" "dvi" "djvu" "chm"))) + +(defvar jao-browse-url-wget-exts + '("ps" "pdf" "dvi" "djvu" "zip" "gz" "tgz")) + +(defvar jao-browse-external-domains + '("github.com" "gitlab.com" "slack.com" "spotify.com" "drive.google.com" + "meet.google.com" "docs.google.com" "x.com" "twitter.com" + "t.com" "linkedin.com" "bigml.com" "slack.com" "zoom.us")) + +(defvar jao-browse--external-regexp + (format "https?://.*%s\\(/.*\\)?" + (regexp-opt jao-browse-external-domains))) + +(defun jao-wget--regexp () + (concat "^http[s]?://.+\\(\\." + (mapconcat 'identity jao-browse-url-wget-exts "\\|\\.") + "\\)\\'")) + +(defun jao--see (url &rest _r) + (start-process-shell-command "see" nil (format "see %s" (jao--fln url)))) + +(defun jao--find-file-other-window (url &rest _) + (find-file-other-window (jao--fln url))) + +(defvar jao-browse--sound-rx + (format "^https?://.*/.*\\.%s" (regexp-opt '("mp3" "flv")))) + +(defun jao-browse-play-sound-url (url &rest _) + (jao-mpc-add-or-play-url url)) + +(defun jao-browse-url-browse (&rest args) + (apply jao-browse-url-function args)) + +(setq browse-url-handlers + `((jao-video--url-p . jao-maybe-view-video) + (,jao--doc-exts . jao--browse-doc) + (,jao--see-exts . jao--see) + ("^file://?.+\\.html?$" . ,jao-browse-url-function) + ("^file://?" . jao--find-file-other-window) + (,jao-browse--external-regexp . ,jao-browse-url-external-function) + ("^https?://.*\\.gotomeeting\\.com\\.*" . browse-url-chrome) + (,jao-browse--sound-rx . jao-browse-play-sound-url) + (,(jao-wget--regexp) . jao-download) + ("." . jao-browse-url-browse))) + +(when (< emacs-major-version 28) + (setf (alist-get 'jao-video--url-p browse-url-handlers nil t) nil) + (setq browse-url-browser-function browse-url-handlers)) + +;;;; subscribe to rss using r2e +(autoload 'View-quit "view") + +(defun jao-rss--find-url () + (save-excursion + (when (derived-mode-p 'w3m-mode 'eww-mode) + (if (fboundp 'w3m-view-source) (w3m-view-source) (eww-view-source))) + (goto-char (point-min)) + (when (re-search-forward + "type=\"application/\\(?:atom\\|rss\\)\\+xml\" +" nil t) + (let ((url (save-excursion + (when (re-search-forward + "href=\"\\([^\n\"]+\\)\"" nil t) + (match-string-no-properties 1)))) + (title (when (re-search-forward + "\\(?:title=\"\\([^\n\"]+\\)\" +\\)" nil t) + (match-string-no-properties 1)))) + (cond ((derived-mode-p 'w3m-view-mode) (w3m-view-source)) + ((string-match-p ".*\\*eww-source\\b.*" (buffer-name)) + (View-quit))) + (when url (cons url (or title ""))))))) + +(defun jao-rss2e-append (name url mbox) + (with-current-buffer (find-file-noselect "~/.config/rss2email.cfg") + (goto-char (point-max)) + (insert "[feed." name "]\nurl = " url) + (insert "\nto = " mbox "+" name "@localhost") + (insert "\nmaildir-mailbox = " mbox "\n\n") + (save-buffer))) + +(defun jao-rss--feeds-dirs () + (mapcar (lambda (d) (cadr (split-string d "\\."))) + (directory-files "~/.emacs.d/gnus/Mail/" nil "^feeds"))) + +(defun jao-rss-subscribe (url) + "Subscribe to a given RSS URL. If URL not given, look for it." + (interactive (list (or (jao-url-around-point) + (jao-rss--find-url) + (read-string "Feed URL: ")))) + (let* ((url+title (ensure-list url)) + (url (car url+title)) + (title (cdr url+title))) + (unless url (error "No feeds found")) + (let ((url (if (string-match "^feed:" url) (substring url 5) url))) + (when (y-or-n-p (format "Subscribe to <%s>? " url)) + (let* ((name (read-string "Feed name: " title)) + (cats (cons "prog" (jao-notmuch--subtags "feeds"))) + (cat (completing-read "Category: " cats nil t)) + (subs (format "r2e add %s '%s' feeds.%s@localhost" + name url cat))) + ;; (jao-rss2e-append name url cat) + (shell-command-to-string subs) + (shell-command (format "r2e run %s" name))))))) + +;;; PDFs and other docs +;;;; open pdfs +(use-package jao-pdf :demand t) + +(use-package saveplace-pdf-view + :ensure t + :demand t + :after doc-view) + +(setq jao-open-doc-fun 'jao-find-or-open) +(setq jao-org-open-pdf-fun 'jao-find-or-open) + +(defun jao-zathura-open (file page) + (let ((id (jao-x11-search-window (jao-pdf-zathura-title-rx file)))) + (if (string-blank-p id) + (progn + (when jao-xmonad-enabled (jao-x11-goto-ws 2)) + (jao-shell-exec (jao-pdf-zathura-open-cmd file page))) + (let* ((page (if page (format " && xdotool type %dg" page) "")) + (cmd (format "xdotool windowactivate %s%s" id page))) + (jao-shell-exec cmd t))))) + +(defun jao-x11-zathura-goto-org (&optional title no-ask) + (let ((title (or title (jao-shell-string "xdotool" + "getactivewindow" + "getwindowname")))) + (jao-org-open-from-zathura title no-ask))) + +(defun jao-find-or-open (file &optional page height) + (cond ((and jao-browse-doc-use-emacs-p window-system) + (let* ((buffs (buffer-list)) + (b (catch 'done + (while buffs + (when (string-equal (buffer-file-name (car buffs)) file) + (throw 'done (car buffs))) + (setq buffs (cdr buffs)))))) + (jao-afio-goto-docs) + (if b (pop-to-buffer b) (find-file file)) + (when page (jao-doc-view-goto-page page height)))) + (jao-river-enabled (jao-river-open-with-zathura file page)) + (jao-sway-enabled (jao-sway-open-with-zathura file page)) + (t (jao-zathura-open file page)))) + +(defun jao-open-doc (&optional file page height) + (interactive) + (when-let (file (or file + (read-file-name "Document: " + (concat jao-org-dir "/doc/")))) + (funcall jao-open-doc-fun file page height))) + +(defun jao-select-pdf () + (interactive) + (jao-buffer-same-mode '(pdf-view-mode doc-view-mode) + #'jao-afio-goto-docs)) + +(defun jao-open-with-zathura () + (interactive) + (when-let (f buffer-file-name) + (let ((p (jao-doc-view-current-page))) + (cond (jao-river-enabled (jao-river-open-with-zathura f p)) + (jao-sway-enabled (jao-sway-open-with-zathura f p)) + (t (jao-zathura-open f p)))))) + +;; doc:// links for browse-url +(defun jao-open-doc-url (url &rest _) + (when (string-match "doc://\\([^?]+\\)\\(\\?.*\\)?" url) + (let ((file (match-string 1 url)) + (page (when-let* ((qs (match-string 2 url)) + (long (> (length qs) 1)) + (ps (url-parse-query-string (substring qs 1))) + (pn (cadr (assoc "page" ps)))) + (string-to-number pn)))) + (jao-open-doc (expand-file-name (concat "doc/" file) jao-org-dir) page)))) + +(add-to-list 'browse-url-handlers (cons "^doc://.+" 'jao-open-doc-url)) + +;;;; doc-view +(use-package doc-view + :init + (setq doc-view-cache-directory "~/.emacs.d/cache/docview" + doc-view-resolution 110 + doc-view-continuous t + doc-view-conversion-refresh-interval 1 + doc-view-mupdf-use-svg t) + :hook ((doc-view-mode . jao-doc-session-mark)) + :bind (:map doc-view-mode-map + ("j" . doc-view-next-line-or-next-page) + ("J" . doc-view-search-next-match) + ("k" . doc-view-previous-line-or-previous-page) + ("K" . doc-view-search-previous-match) + ("z" . jao-open-with-zathura))) + +(use-package jao-doc-session :demand t) + +(use-package jao-doc-view + :demand t + :bind (:map doc-view-mode-map + ("b" . jao-doc-view-back) + ("B" . jao-doc-view-forward) + ("S" . jao-doc-session-save) + ("u" . jao-doc-view-visit-url))) + +;;;; epub +(use-package nov + :ensure t + :after doc-view + :init (setq nov-variable-pitch t + nov-text-width nil) + :config + (add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode)) + (defun jao-nov-register-session () + (jao-doc-session-mark nov-file-name)) + (add-hook 'nov-mode-hook #'jao-nov-register-session)) + +;;;; transient +(defun jao-org-pdf-goto-org-linking () + (interactive) + (jao-org-pdf-goto-org 4)) + +(jao-transient-major-mode doc-view + ["Notes" + ("o" "notes file" jao-org-pdf-goto-org) + ("O" "notes file, linking" jao-org-pdf-goto-org-linking)] + ["Navigation" + ("b" "back jump" jao-doc-view-back) + ("B" "forward jump" jao-doc-view-back) + ("u" "visit URL" jao-doc-view-visit-url)] + ["Slices" + ("cb" "bounding box" doc-view-set-slice-from-bounding-box) + ("cm" "using mouse" doc-view-set-slice-using-mouse)] + ["Session" + ("s" "load session" jao-afio-open-pdf-session) + ("S" "save session" jao-doc-session-save) + ("d" "visit cache directory" doc-view-dired-cache)] + ["External viewers" + ("z" "open with zathura" jao-open-with-zathura)]) + +(with-eval-after-load "pdf-view" + (jao-transient-major-mode pdf-view + ["Notes" + ("o" "notes file" jao-org-pdf-goto-org) + ("O" "notes file, linking" jao-org-pdf-goto-org-linking)] + ["Navigation" + ("b" "back jump" pdf-history-backward) + ("f" "forward jump" pdf-history-forward)] + ["Session" + ("s" "load session" jao-afio-open-pdf-session) + ("S" "save session" jao-doc-session-save)] + ["External viewers" + ("z" "open with zathura" jao-open-with-zathura)])) + +;; (transient-get-suffix 'jao-transient-pdf-view '(0 -1)) + +;;; Email +(require 'jao-custom-email) + +;;; Shells and terms +;;;; shell modes +(setq sh-basic-offset 2) +;; translates ANSI colors into text-properties, for eshell +(autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t) +(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on) +(defvar jao-use-vterm nil) +(defvar jao-use-eat nil) + +(add-to-list 'display-buffer-alist + '("\\*Async Shell Command\\*" (display-buffer-no-window))) + +;;;; eat +(use-package eat + :ensure t + :commands jao-exec-in-term + :init (setq jao-use-eat t + eat-kill-buffer-on-exit t + eat-enable-yank-to-terminal t) + :hook ((eshell-mode . eat-eshell-mode) + (eshell-mode . eat-eshell-visual-command-mode)) + :diminish ((eat-eshell-mode . ""))) + +;;;; term +(defvar-local jao-term--cmd nil) + +(defun jao-term--find (cmd) + (seq-find (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'eat-mode 'term-mode 'vterm-mode) + (string= (or jao-term--cmd "") cmd)))) + (buffer-list))) + +(defun jao-exec-in-term (cmd &optional name) + (interactive "SCommand") + (require 'eat nil t) + (cond ((and jao-use-vterm (fboundp 'jao-exec-in-vterm)) + (jao-exec-in-vterm cmd name)) + (jao-use-eat (let ((eat-term-name "xterm-256color")) + (with-current-buffer (eat cmd t) + (setq-local jao-term--cmd cmd)))) + (t (ansi-term "bash" name) + (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 (concat cmd " ; exit\n"))))) + +(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)))))) + +;;;; eshell +;;;;; basic custom +(use-package eshell + :init + (setq eshell-directory-name "~/.emacs.d/eshell" + eshell-hist-ignoredups 'erase + eshell-history-size 1000000 + eshell-error-if-no-glob nil) + + (defun jao-eshell--outline () + (setq-local outline-regexp eshell-prompt-regexp)) + + :config (setq eshell-prompt-repeat-map nil) + + :hook (eshell-mode . jao-eshell--outline)) + +;;;;; colors +(autoload 'ansi-color-apply "ansi-color") +;; (add-hook 'eshell-preoutput-filter-functions 'ansi-color-filter-apply) +(add-hook 'eshell-preoutput-filter-functions 'ansi-color-apply) + +(use-package eshell-syntax-highlighting + :after esh-mode + :ensure t + :config + ;; Enable in all Eshell buffers. + (eshell-syntax-highlighting-global-mode +1)) + +;;;;; visual commands +(require 'em-term) + +(dolist (c '("editor" "more" "wget" "dict" "vim" "links" "w3m" "guile" + "zmore" "pager" "aptitude" "su" "htop" "top" + "screen" "whizzml" "iex" "spt")) + (add-to-list 'eshell-visual-commands c)) + +(setq eshell-visual-subcommands '(("git" "log" "diff" "show") + ("sudo" "vim") + ("rebar3" "shell")) + eshell-destroy-buffer-when-process-dies nil + eshell-escape-control-x t) + +;;;;; bol +(defun jao-eshell-maybe-bol () + (interactive) + (let ((p (point))) + (eshell-bol) + (if (= p (point)) + (beginning-of-line)))) + +;;;;; prompt +;; tracking git repos +(defun jao-eshell--git-dirty () + (shell-command-to-string "git diff-index --quiet HEAD -- || echo -n '*'")) + +(use-package git-ps1-mode + :ensure t + :init (setq git-ps1-mode-showupstream "1" + git-ps1-mode-showdirtystate "1")) + +(defun jao-eshell--git-info () + (if (fboundp 'git-ps1-mode-get-current) + (git-ps1-mode-get-current) + (let ((desc (shell-command-to-string "git branch --no-color"))) + (when (string-match "^* \\(\\<.+\\>\\)" desc) + (format "%s%s" (match-string 1 desc) (jao-eshell--git-dirty)))))) + +(defun jao-eshell--git-current-branch (suffix) + (let ((desc (or (jao-eshell--git-info) ""))) + (cond ((and (string-empty-p desc) suffix) (format " (%s)" suffix)) + ((string-empty-p (or suffix "")) (format " (%s)" desc)) + (t (format " (%s %s)" desc suffix))))) + +(defun jao-eshell--virtualenv () + (let ((venv (getenv "VIRTUAL_ENV"))) + (when (and venv (string-match ".*/\\([^/]+\\)/$" venv)) + (match-string-no-properties 1 venv)))) + +(defun jao-eshell-prompt-function () + (let* ((venv (jao-eshell--virtualenv)) + (venv (if venv (format "%s" venv) ""))) + (concat (abbreviate-file-name (eshell/pwd)) + (jao-eshell--git-current-branch venv) + (if (= (user-uid) 0) " # " " $ ")))) + +(setq eshell-prompt-function 'jao-eshell-prompt-function) + +;;;;; in-term +(defun eshell/in-term (prog &rest args) + (switch-to-buffer + (apply #'make-term (format "in-term %s %s" prog args) prog nil args)) + (term-mode) + (term-char-mode)) + +;;;;; dir navigation +(use-package eshell-up + :ensure t + :config (setq eshell-up-print-parent-dir t)) + +(use-package eshell-autojump :ensure t) + +;;;;; completion +(defun jao-eshell-completion-capf () + (let* ((b (save-excursion (eshell-bol) (point))) + (c (bash-completion-dynamic-complete-nocomint b (point) t))) + (when (and c (listp c)) + (append c '(:exclusive no))))) + +(defun jao-eshell--set-up-completion () + (setq-local completion-styles '(basic partial-completion) + completion-at-point-functions + '(jao-eshell-completion-capf + pcomplete-completions-at-point t))) + +(use-package bash-completion + :ensure t + :hook (eshell-mode . jao-eshell--set-up-completion)) + +;;;;; toggle +(use-package jao-eshell-here + :demand t + :config (jao-define-attached-buffer "^\\*eshell" 0.5) + :bind (("<f1>" . jao-eshell-here-toggle) + ("C-<f1>" . jao-eshell-here-toggle-new))) + +;;;;; workarounds +;; at some point, bash completion started insertig the TAB +;; after the commands ends +(defun jao-eshell--clean-prompt () + (eshell-bol) + (ignore-errors (kill-line))) + +(add-hook 'eshell-after-prompt-hook 'jao-eshell--clean-prompt) + +;;;;; keybindings +(defun jao-eshell--kbds () + (define-key eshell-mode-map "\C-a" 'jao-eshell-maybe-bol) + (define-key eshell-mode-map "\C-ci" 'consult-outline)) + +(jao-eshell--kbds) + +;;; Version control and CI +;;;; vc options +(setq vc-follow-symlinks t) +(setq auto-revert-check-vc-info nil) + +;;;; diff fringe indicators (diff-hl) +(use-package diff-hl + :ensure t + :custom ((diff-hl-draw-borders nil) + (diff-hl-side 'right) + (diff-hl-margin-symbols-alist + '((insert . "█") + (delete . "█") + (change . "█") + (unknown . "█") + (ignored . "█")))) + :config + (map-keymap (lambda (_k cmd) + (put cmd 'repeat-map 'diff-hl-command-map)) + diff-hl-command-map) + (add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh)) + +(global-diff-hl-mode 1) +(unless (display-graphic-p) (diff-hl-margin-mode 1)) + +;;;; magit/forge +(use-package magit + :ensure t + :commands magit-status + :init + (setq magit-status-initial-section nil + magit-define-global-key-bindings nil + magit-completing-read-function 'magit-builtin-completing-read + magit-display-buffer-function + 'magit-display-buffer-fullcolumn-most-v1 + magit-delete-by-moving-to-trash nil + magit-last-seen-setup-instructions "1.4.0" + magit-log-edit-confirm-cancellation t + magit-omit-untracked-dir-contents t + magit-process-connection-type nil + magit-push-always-verify nil + magit-repository-directories + '(("/home/jao/usr/bigml" . 2) + ("/home/jao/usr/jao" . 3) + ("/usr/local/src" . 1)) + magit-save-repository-buffers 'dontask + magit-section-visibility-indicator '("…" . t) + magit-status-buffer-switch-function 'switch-to-buffer + magit-status-show-hashes-in-headers t)) + +;;;; forge +(use-package forge + :ensure t + :after magit + :init + (setq forge-topic-list-limit (cons 100 -1) + forge-pull-notifications nil) + :config + (use-package embark-vc :ensure t) + :bind ((:map forge-topic-mode-map ("M-w" . copy-region-as-kill)))) + + +;;;; code reviews +(use-package code-review + :disabled t + :ensure t + :after forge + :bind (:map magit-status-mode-map + ("C-c C-r" . code-review-forge-pr-at-point))) + +;;;; other git packages +(use-package git-timemachine :ensure t) + +;; (use-package consult-git-log-grep +;; :ensure t +;; :custom (consult-git-log-grep-open-function #'magit-show-commit) +;; :bind (("C-c K" . consult-git-grep))) + +;; git config --local git-link.remote / git-link.branch +(use-package git-link :ensure t) +(use-package git-modes :ensure t) + +;;;; jenkins +(use-package jenkins + :ensure t + :init + ;; one also needs jenkins-api-token, jenkins-username and jenkins-url + ;; optionally: jenkins-colwidth-id, jenkins-colwidth-last-status + (setq jenkins-colwidth-name 35) + :config + (defun jao-jenkins-first-job (&rest _) + (interactive) + (goto-char (point-min)) + (when (re-search-forward "^- Job" nil t) + (goto-char (match-beginning 0)))) + (add-hook 'jenkins-job-view-mode-hook #'jao-jenkins-first-job) + (advice-add 'jenkins-job-render :after #'jao-jenkins-first-job) + + (defun jenkins-refresh-console-output () + (interactive) + (let ((n (buffer-name))) + (when (string-match "\\*jenkins-console-\\([^-]+\\)-\\(.+\\)\\*$" n) + (jenkins-get-console-output (match-string 1 n) (match-string 2 n)) + (goto-char (point-max))))) + + :bind (:map jenkins-job-view-mode-map + (("n" . next-line) + ("p" . previous-line) + ("f" . jao-jenkins-first-job) + ("RET" . jenkins--show-console-output-from-job-screen)) + :map jenkins-console-output-mode-map + (("n" . next-line) + ("p" . previous-line) + ("g" . jenkins-refresh-console-output)))) + +;;; Programming +;;;; automatic modes +(add-to-list 'auto-mode-alist '("\\.mix\\'" . hexl-mode)) +(add-to-list 'auto-mode-alist '("\\.m4\\'" . m4-mode)) +(add-to-list 'auto-mode-alist '("\\.am\\'" . makefile-mode)) +(add-to-list 'auto-mode-alist '("\\.pl\\'\\|\\.pm\\'" . cperl-mode)) + +;;;; symbol overlay +(use-package symbol-overlay + :ensure t + :config + (defun jao-symbol-reveal (&rest _) + (when outline-minor-mode (outline-show-entry))) + (advice-add 'symbol-overlay-basic-jump :after 'jao-symbol-reveal) + + (defun jao-symbol-put-and-next () + (interactive) + (symbol-overlay-put) + (symbol-overlay-jump-next)) + + (defun jao-symbol-put-and-prev () + (interactive) + (symbol-overlay-put) + (symbol-overlay-jump-prev)) + + :bind (:map prog-mode-map (("M-i" . symbol-overlay-put) + ("M-n" . jao-symbol-put-and-next) + ("M-p" . jao-symbol-put-and-prev))) + :hook (prog-mode . symbol-overlay-mode) + :diminish " ^") + +;;;; eglot +(use-package eglot + :bind (:map eglot-mode-map (("C-h ." . jao-eldoc-toggle)))) + +;;;; paredit and parens +(require 'paren) +(show-paren-mode t) +(setq show-paren-context-when-offscreen t + show-paren-when-point-inside-paren nil) + +(use-package paredit + :ensure t + :commands paredit-mode + :hook ((pie-mode . paredit-mode) + (scheme-mode . paredit-mode) + (clojure-mode . paredit-mode) + (emacs-lisp-mode . paredit-mode) + ;; (eval-expression-minibuffer-setup . paredit-mode) + (lisp-interaction-mode . disable-paredit-mode)) + :diminish ((paredit-mode . " þ"))) + +;;;; diff/ediff +(setq ediff-split-window-function 'split-window-horizontally) +(setq ediff-make-buffers-readonly-at-startup nil) +(setq ediff-window-setup-function 'ediff-setup-windows-plain) +(setq ediff-keep-variants nil) + +;;;; compilation +;;;;; compilation mode options +(require 'compile) +(setq compilation-scroll-output t) +(setq compilation-error-regexp-alist + (remove 'omake compilation-error-regexp-alist)) +;; (add-hook 'compilation-mode-hook #'visual-line-mode) + +;;;;; mode line (no "Compiling"!) +(require 'compile) +(diminish 'compilation-minor-mode " ‡") +(when (< emacs-major-version 27) + (setcdr (assq 'compilation-in-progress minor-mode-alist) '(" ‡"))) +(when (> emacs-major-version 26) + (setcdr (assq 'compilation-in-progress mode-line-modes) '("‡ "))) + +;;;;; colorizing compilation buffer +(setq compilation-message-face 'default) +(require 'ansi-color) +(defun endless/colorize-compilation () + "Colorize from `compilation-filter-start' to `point'." + (let ((inhibit-read-only t)) + (ansi-color-apply-on-region + compilation-filter-start (point)))) + +(add-hook 'compilation-filter-hook #'endless/colorize-compilation) + +;;;;; compilation commands +(use-package jao-compilation + :commands jao-compilation-setup + :bind (("C-c C" . compile) + ("C-c c" . jao-compile))) +(jao-compilation-setup) + +;;;;; next error +(setq next-error-find-buffer-function + #'next-error-buffer-on-selected-frame + next-error-verbose t) + +;;;; flymake +(use-package flymake + :ensure t + :custom ((flymake-mode-line-format '(" " flymake-mode-line-counters))) + :config + (jao-define-attached-buffer "^\\*Flymake diagnostics .*\\*\\'") + + (transient-define-prefix jao-transient-flymake () + ["Flymake" + ("d" "show diagnostics" flymake-show-buffer-diagnostics) + ("i" "show diagnostic" flymake-show-diagnostic) + ("n" "next error" flymake-goto-next-error) + ("p" "previous error" flymake-goto-prev-error) + ("c" "consult flymake" consult-flymake)]) + + :bind (:map flymake-mode-map (("M-m" . jao-transient-flymake)))) + +;;;; workarounds +(setq c-type-finder-time-slot nil) + +;;;; outline minor mode +(use-package outline + :init (setq outline-minor-mode-use-buttons nil + outline-minor-mode-use-margins nil + outline-minor-mode-cycle t)) + +(defvar-local jao-outline-folded nil) +(dolist (v '(4 5 outline-show-only-headings)) + (add-to-list 'safe-local-variable-values `(outline-default-state . ,v))) + +(defun jao-outline-minor-mode-hide-all (&optional arg) + (interactive "P") + (outline-hide-sublevels (if arg 5 4))) + +(defun jao-outline-minor-expand-all () + (when jao-outline-minor-mode (outline-show-all))) + +(defun jao-outline-minor-mode-toogle-fold (&optional arg) + (interactive "P") + (if (setq jao-outline-folded (not jao-outline-folded)) + (jao-outline-minor-mode-hide-all arg) + (jao-outline-minor-expand-all))) + +(use-package outline-minor-faces + :ensure t + :after outline) + +(define-minor-mode jao-outline-minor-mode + "Minor outline mode for programming languages" + :lighter "" + :keymap `((,(kbd "C-c C-n") . outline-next-visible-heading) + (,(kbd "C-c C-p") . outline-previous-visible-heading) + (,(kbd "C-c o") . consult-outline) + (,(kbd "<f3>") . jao-outline-minor-mode-toogle-fold)) + (if jao-outline-minor-mode + (progn (setq-local outline-level #'outline-level + outline-regexp (format "[%s]\\{3,\\} " comment-start)) + (outline-minor-mode 1) + (outline-minor-faces-mode 1)) + (outline-minor-mode -1) + (outline-minor-faces-mode -1))) + +(add-hook 'find-function-after-hook #'jao-outline-minor-expand-all) + +;;; Programming languages +;;;; Elisp +(add-hook 'emacs-lisp-mode-hook #'jao-outline-minor-mode) + +(use-package edit-list :ensure t) +;; (use-package package-lint :ensure t) +;; (use-package tree-inspector :ensure t) + +(defun elisp-disassemble (function) + (interactive (list (function-called-at-point))) + (disassemble function)) + +(defun elisp-pp (sexp) + (with-output-to-temp-buffer "*Pp Eval Output*" + (pp sexp) + (with-current-buffer standard-output + (emacs-lisp-mode)))) + +(defun elisp-macroexpand (form) + (interactive (list (form-at-point 'sexp))) + (elisp-pp (macroexpand form))) + +(defun elisp-macroexpand-all (form) + (interactive (list (form-at-point 'sexp))) + (elisp-pp (macroexpand-all form))) + +(defun elisp-find-definition (name) + (interactive (list (thing-at-point 'symbol))) + (cond (name + (let ((symbol (intern-soft name)) + (search (lambda (fun sym) + (let* ((r (save-excursion (funcall fun sym))) + (buffer (car r)) + (point (cdr r))) + (cond ((not point) + (error "Found no definition for %s in %s" + name buffer)) + (t + (switch-to-buffer buffer) + (goto-char point) + (recenter 1))))))) + (cond ((fboundp symbol) + (xref-push-marker-stack) + (funcall search 'find-function-noselect symbol)) + ((boundp symbol) + (xref-push-marker-stack) + (funcall search 'find-variable-noselect symbol)) + (t + (message "Symbol not bound: %S" symbol))))) + (t (message "No symbol at point")))) + + +(defun elisp-bytecompile-and-load () + (interactive) + (or buffer-file-name + (error "The buffer must be saved in a file first")) + (require 'bytecomp) + ;; Recompile if file or buffer has changed since last compilation. + (when (and (buffer-modified-p) + (y-or-n-p (format "save buffer %s first? " (buffer-name)))) + (save-buffer)) + (let ((filename (expand-file-name buffer-file-name))) + (with-temp-buffer + (byte-compile-file filename)))) + +(use-package elisp-mode + :bind (:map emacs-lisp-mode-map + (("C-c C-M" . emacs-lisp-macroexpand) + ("C-c C-m" . elisp-macroexpand-all) + ("C-c C-k" . elisp-bytecompile-and-load) + ;; ("C-c C-p" . pp-eval-last-sexp) + ("M-." . elisp-find-definition) + ("M-," . pop-tag-mark) + ("C-c <" . lc-show-package-summary)))) + +;;;; Clojure +(use-package clojure-mode + :ensure t + :config + (defun jao-clojure--fix-things () + (setq-local completion-styles '(basic partial-completion emacs22)) + (eldoc-mode 1) + (setq mode-name "λ")) + :hook (clojure-mode . jao-clojure--fix-things)) + +(use-package cider + :ensure t + :commands cider-mode + :init (setq cider-annotate-completion-candidates t + cider-auto-select-error-buffer nil + cider-auto-select-test-report-buffer nil + cider-eldoc-display-for-symbol-at-point t + cider-eldoc-ns-function #'identity ;; #'cider-last-ns-segment + cider-enrich-classpath nil + cider-lein-parameters "repl :headless :host localhost" + cider-mode-line " ÷" + cider-prompt-for-symbol nil + cider-repl-history-file + (expand-file-name "~/.emacs.d/cache/cider.history") + cider-repl-pop-to-buffer-on-connect nil + cider-repl-use-pretty-printing t + cider-show-error-buffer 'except-in-repl + cider-test-show-report-on-success nil + cider-use-fringe-indicators nil + cider-use-overlays nil + clojure-docstring-fill-column 72 + nrepl-prompt-to-kill-server-buffer-on-quit nil) + :bind (("<f3>" . cider-selector))) + +(with-eval-after-load "cider-test" + (advice-add 'cider-scale-background-color :override + (lambda () (frame-parameter nil 'background-color))) + (setq cider-test-items-background-color + (frame-parameter nil 'background-color))) + +(use-package cider-macroexpansion + :after cider + :diminish " µ") + +;;;; Geiser +(defun jao-org--set-geiser-impl () (setq-local geiser-repl--impl 'guile)) +(add-hook 'org-mode-hook #'jao-org--set-geiser-impl) + +(jao-load-path "geiser") +;; (package-vc-install-from-checkout ...) +(use-package geiser + :demand t + :init + (setq geiser-repl-history-filename "~/.emacs.d/cache/geiser-history" + geiser-repl-startup-time 20000 + geiser-debug-auto-display-images t + geiser-log-verbose t) + :config + (dolist (m '(geiser-repl-mode geiser-doc-mode geiser-debug-mode)) + (jao-define-attached-buffer `(major-mode . ,m) 0.4))) + +(jao-load-path "geiser-guile") +(use-package geiser-guile) + +(jao-load-path "geiser-chez") +(use-package geiser-chez) + +;; (jao-load-path "geiser/mit") +;; (use-package geiser-mit) + +;; (jao-load-path "geiser/chicken") +;; (use-package geiser-chicken) + +;; (jao-load-path "geiser/chibi") +;; (use-package geiser-chibi) + +;; (jao-load-path "geiser/gambit") +;; (use-package geiser-gambit) + +;; (jao-load-path "geiser/gauche") +;; (use-package geiser-gauche) + +;;;; Haskell +;;;;; packages +;; (jao-load-path "haskell-mode") + +(use-package haskell-mode + :ensure t + :custom + ((inferior-haskell-find-project-root t) + (haskell-check-remember-last-command-p nil) + (haskell-completing-read-function 'completing-read) + (haskell-font-lock-symbols nil) + (haskell-hoogle-command "hoogle") + (haskell-interactive-popup-errors t) + (haskell-process-auto-import-loaded-modules t) + (haskell-process-log t) + (haskell-process-suggest-remove-import-lines t) + (haskell-process-suggest-hoogle-imports t) + (haskell-process-type 'cabal-repl) + (haskell-process-use-presentation-mode t) + (haskell-stylish-on-save nil) + (haskell-tags-on-save t)) + + :init + ;; For use with M-x align + (require 'align) + (add-to-list 'align-rules-list + '(haskell-types + (regexp . "\\(\\s-+\\)\\(::\\|∷\\)\\s-+") + (modes quote (haskell-mode haskell-literate-mode)))) + (add-to-list 'align-rules-list + '(haskell-assignment + (regexp . "\\(\\s-+\\)=\\s-+") + (modes quote (haskell-mode haskell-literate-mode)))) + (add-to-list 'align-rules-list + '(haskell-arrows + (regexp . "\\(\\s-+\\)\\(->\\|→\\)\\s-+") + (modes quote (haskell-mode haskell-literate-mode)))) + (add-to-list 'align-rules-list + '(haskell-left-arrows + (regexp . "\\(\\s-+\\)\\(<-\\|←\\)\\s-+") + (modes quote (haskell-mode haskell-literate-mode)))) + + :config + (defun jao-haskell-hoogle (no-info) + (interactive "P") + (haskell-hoogle (format "%s" (haskell-ident-at-point)) (not no-info))) + + (put 'haskell-process-args-cabal-repl + 'safe-local-variable + (apply-partially #'seq-every-p #'stringp)) + + (defun jao-haskell-eldoc (cb) + (let ((msg (or (haskell-doc-current-info--interaction t) + (haskell-doc-sym-doc (haskell-ident-at-point)) + ""))) + (funcall cb (replace-regexp-in-string "[\n ]+" " " msg)))) + + (setq tags-revert-without-query t) + + (defun jao-haskell-mode () + (require 'haskell-doc) + (setq-local eldoc-documentation-function 'eldoc-documentation-default + eldoc-documentation-functions '(jao-haskell-eldoc)) + (eldoc-mode)) + + (dolist (h '(jao-haskell-mode + haskell-decl-scan-mode + haskell-indentation-mode + interactive-haskell-mode)) + (add-hook 'haskell-mode-hook h)) + + (add-hook 'haskell-presentation-mode-hook (lambda () (whitespace-mode -1))) + + :bind (:map haskell-mode-map + (("C-c C-d" . jao-haskell-hoogle) + ("C-c C-s" . haskell-session-change-target) + ("C-c h" . haskell-hoogle) + ("C-c t" . haskell-doc-show-type) + ("C-c C-e" . haskell-command-insert-language-pragma) + ("C-M-n" . flymake-goto-next-error) + ("C-M-p" . flymake-goto-prev-error) + ("<f3>" . haskell-session-kill)))) + +(use-package hlint-refactor + :ensure t + :after haskell-mode + :hook ((haskell-mode . hlint-refactor-mode)) + :bind (:map haskell-mode-map (("C-M-h" . 'hlint-refactor-refactor-at-point) + ("C-M-S-h" . 'hlint-refactor-refactor-buffer))) + :diminish) + +(use-package flymake-hlint + :ensure t + :after haskell-mode + :hook ((haskell-mode . flymake-hlint-load))) + + +(use-package consult-hoogle + :ensure t) + +(require 'haskell) + +(diminish 'interactive-haskell-mode " λ") +(diminish 'haskell-doc-mode) +(diminish 'haskell-decl-scan-mode) + +(jao-define-attached-buffer "\\*hoogle\\*.*") +(jao-define-attached-buffer '(major-mode . haskell-interactive-mode) 0.33) +(jao-define-attached-buffer '(major-mode . haskell-presentation-mode) 0.25) + +;;;;; transient +(jao-transient-major-mode haskell + ["Imports" + ("in" "Navigate imports" haskell-navigate-imports) + ("if" "Format imports" haskell-mode-format-imports) + ("is" "Sort imports" haskell-sort-imports) + ("ia" "Align imports" haskell-align-imports)] + ["Session" + ("s" "Change the session's target" haskell-session-change-target)] + ["Code" + ("e" "insert language pragma" haskell-command-insert-language-pragma) + ("v" "visit cabal file" haskell-cabal-visit-file) + ("h" "hoogle" jao-haskell-hoogle) + ("t" "show type" haskell-doc-show-type)] + ["Flymake" + ("n" "next error" flymake-goto-next-error) + ("p" "previous error" flymake-goto-prev-error)]) + +;;;; Pie +(jao-load-path "pie") +(use-package pie + :demand t + :commands (pie-mode)) + +;;;; Prolog +;; (use-package ediprolog :ensure t) + +(use-package prolog + :ensure t + :commands (run-prolog prolog-mode mercury-mode) + :init (progn + (setq prolog-system 'swi) + (add-to-list 'auto-mode-alist '("\\.pl$" . prolog-mode)) + (setq prolog-consult-string '((t "[%f]."))) + (setq prolog-program-name + '(((getenv "EPROLOG") (eval (getenv "EPROLOG"))) + (eclipse "eclipse") + (mercury nil) + (sicstus "sicstus") + (swi "swipl") + (t "prolog"))))) + +;;;; Python +(use-package virtualenvwrapper + :ensure t + :config + (venv-initialize-eshell) + (jao-compilation-env "VIRTUAL_ENV")) +;;;; Javascript + +(use-package typescript-mode + :ensure t + :custom ((typescript-indent-level 2))) + +;;; Text/data formats +;;;; json +(use-package json-mode :ensure t) +;;;; yaml +(use-package yaml-mode :disabled t :ensure t) + +;;; Graphics +;;;; images +(setq image-use-external-converter t + image-cache-eviction-delay 120) +(setq widget-image-enable nil) + +;;;; gnuplot +(use-package gnuplot + :disabled t + :ensure t + :commands (gnuplot-mode gnuplot-make-buffer) + :init (add-to-list 'auto-mode-alist '("\\.gp$" . gnuplot-mode))) + +;;; Network +;;;; nm applet +(jao-shell-def-exec jao-nm-applet "nm-applet") + +(defun jao-toggle-nm-applet () + (interactive) + (or (jao-shell-kill-p "nm-applet") (jao-nm-applet))) + +;;;; bluetooth +(use-package bluetooth :ensure t) + +;;;; vpn +(use-package jao-mullvad :demand t) + +;;;; ssh +(use-package tramp) +(defun jao-tramp-hosts () + (seq-uniq + (mapcan (lambda (x) + (remove nil (mapcar 'cadr (apply (car x) (cdr x))))) + (tramp-get-completion-function "ssh")) + #'string=)) + +(defun jao-ssh (&optional scratch) + (interactive "P") + (let ((h (completing-read "Host: " (jao-tramp-hosts)))) + (when scratch (jao-afio-goto-scratch)) + (jao-exec-in-term (format "ssh %s" h) (format "*ssh %s*" h)))) + +;;; Chats +;;;; circe +(defvar jao-libera-channels ()) +(defvar jao-oftc-channels ()) +(defvar jao-bitlbee-channels ()) +(defvar jao-slack-channels ()) + +(use-package circe + :ensure t + :bind (:map circe-channel-mode-map + (("C-c C-a" . lui-track-jump-to-indicator))) + :init + (setq circe-chat-buffer-name "{target}" + circe-default-realname "https://jao.io" + circe-default-part-message "" + circe-default-quit-message "" + circe-ignore-list nil + circe-server-coding-system '(undecided . undecided) + circe-server-killed-confirmation 'ask-and-kill-all + circe-server-auto-join-default-type :after-auth + circe-format-say "({nick}) {body}" + circe-format-self-say "(jao) {body}" + circe-new-buffer-behavior 'ignore + circe-new-buffer-behavior-ignore-auto-joins t + circe-nickserv-ghost-style 'after-auth + circe-prompt-string ": " + circe-completion-suffix ", " + circe-reduce-lurker-spam t + + circe-lagmon-mode-line-format-string "" ;; "%.0f " + circe-lagmon-mode-line-unknown-lag-string "" ;; "? " + circe-lagmon-timer-tick 120 + circe-lagmon-reconnect-interval 180 + + lui-max-buffer-size 30000 + lui-fill-column 80 + lui-time-stamp-position 'right + lui-time-stamp-format "%H:%M" + lui-flyspell-p nil + + lui-track-indicator (if window-system 'fringe 'bar) + lui-track-behavior 'before-tracking-next-buffer) + :config + + (defsubst jao-circe-nick-no () + (if (derived-mode-p 'circe-query-mode) + 2 + (length (circe-channel-nicks)))) + + (defsubst jao-circe-netowrk () + (or (plist-get lui-logging-format-arguments :network) "")) + + (define-minor-mode jao-circe-user-number-mode "" + :lighter (:eval (format " [%s]" (jao-circe-nick-no)))) + + (defun jao-circe-channel-hook () + (when jao-mode-line-in-minibuffer + (setq header-line-format + '(" %b" (:eval (format "@%s - %s nicks" + (jao-circe-netowrk) + (jao-circe-nick-no)))))) + (jao-circe-user-number-mode 1)) + + (add-hook 'circe-channel-mode-hook #'jao-circe-channel-hook) + (add-hook 'circe-query-mode-hook #'jao-circe-channel-hook) + + (defun circe-command-RECOVER (&rest _ignore) + "Recover nick" + (jao-with-auth "freenode" u p + (circe-command-MSG "nickserv" (format "IDENTIFY %s %s" u p)) + (circe-command-MSG "nickserv" (format "GHOST %s" u)) + (circe-command-MSG "nickserv" (format "RELEASE %s" u)) + (circe-command-NICK u))) + + (defun circe-command-NNICKS (&rest _) + "Echo number of nicks" + (circe-display-server-message + (format "%d nicks in this channel" (jao-circe-nick-no)))) + + (defun circe-command-SENDFILE (line) + "/sendfile for localslackirc" + (circe-command-QUOTE (format "sendfile %s" line))) + + (advice-add 'circe-command-NAMES :after #'circe-command-NNICKS) + + (setq circe-network-options + (list (jao-with-auth "libera" u p + (list "Libera Chat" :nick u :channels jao-libera-channels + :tls t :sasl-username u :sasl-password p)) + (jao-with-auth "oftc" u p + (list "OFTC" + :nick u :channels jao-oftc-channels :nickserv-password p + :tls t :sasl-username u :sasl-password p)) + (jao-with-auth "bitlbee" u p + (list "Bitlbee" :host "127.0.0.1" :nick u + :channels jao-bitlbee-channels :lagmon-disabled t + :nickserv-password u :user p)) + (list "bigml" :host "127.0.0.1" :nick "jao" + :channels jao-slack-channels :port 9007 + :lagmon-disabled t) + (list "recoveryou" :host "127.0.0.1" :nick "jao" + :port 9008 :lagmon-disabled t) + (list "grio" :host "127.0.0.1" :nick "jao" + :port 9009 :lagmon-disabled t))) + + (jao-shorten-modes 'circe-channel-mode + 'circe-server-mode + 'circe-query-mode) + + (enable-circe-display-images) + (enable-lui-track) + (circe-lagmon-mode)) + +;;;; telegram +(use-package telega + :ensure t + :custom + (telega-use-tracking-for '(unmuted) ;; '(or unmuted mention) + telega-rainbow-color-custom-for nil + telega-msg-rainbow-title nil + telega-sticker-set-download t + telega-symbol-checkmark "·" + telega-symbol-heavy-checkmark "×" + telega-symbol-verified "*") + :config + (define-key global-map (kbd "C-c C-t") telega-prefix-map) + (setq telega-chat-show-avatars nil + telega-chat-prompt-insexp '(telega-ins "> ") + telega-completing-read-function #'completing-read + telega-root-show-avatars nil + telega-emoji-use-images nil + telega-temp-dir "/tmp/telega" + telega-symbol-horizontal-bar + (propertize "-" 'face 'jao-themes-f00) + telega-symbol-vertical-bar + (propertize "| " 'face 'jao-themes-dimm) + telega-mode-line-string-format + '(:eval (telega-mode-line-unread-unmuted)) + telega-use-images (display-graphic-p) + telega-open-file-function #'jao--see + telega-open-message-as-file + (unless (display-graphic-p) '(photo video animation))) + (with-eval-after-load "tracking" + (jao-shorten-modes 'telega-chat-mode) + (jao-tracking-faces 'telega-tracking)) + (telega-mode-line-mode 1)) + +(defun jao-telega () + (interactive) + (jao-tracking-go-to-chats) + (if (get-buffer telega-root-buffer-name) + (pop-to-buffer telega-root-buffer-name) + (telega))) + +;;;; ement +(use-package ement + :disabled t + :ensure t + :init (setq ement-save-sessions t + ement-sessions-file (locate-user-emacs-file "cache/ement.el") + ement-room-avatars nil + ement-notify-dbus-p nil + ement-room-left-margin-width 0 + ement-room-right-margin-width 11 + ement-room-timestamp-format "%H:%M" + ement-room-timestamp-header-format "--------") + + :custom ((ement-room-message-format-spec "(%S) %B%r%R %t")) + + :config + (defun jao-ement-track (event room session) + (when (ement-notify--room-unread-p event room session) + (when-let ((n (ement-room--buffer-name room)) + (b (get-buffer n))) + (tracking-add-buffer b)))) + + (add-hook 'ement-event-hook #'jao-ement-track) + (jao-shorten-modes 'ement-room-mode) + (jao-tracking-cleaner "^\\*Ement Room: \\(.+\\)\\*" "@\\1")) + +;;;; mastodon +(use-package mastodon + :ensure t + :init + (setq mastodon-instance-url "https://fosstodon.org" + mastodon-active-user "jao@gnu.org" + mastodon-group-notifications t + mastodon-images-in-notifs t + mastodon-tl-position-after-update nil + mastodon-toot-display-orig-in-reply-buffer t + mastodon-media--hide-sensitive-media nil) + :config + ;; (defun jao-mastodon--setup () + ;; (setq-local scroll-margin 12)) + + ;; (add-hook 'mastodon-mode-hook #'jao-mastodon--setup) + (with-eval-after-load "ewww" + (define-key eww-mode-map (kbd "T") #'jao-mastodon-toot-url))) + +(defun jao-mastodon-toot-url () + (interactive) + (when-let (url (jao-url-around-point t)) + (jao-tracking-go-to-chats) + (mastodon-toot--compose-buffer nil nil nil url))) + +(defun jao-mastodon () + (interactive) + (jao-afio-goto-chats) + (mastodon)) + +;; https://0x0.st/XJ14.txt +(jao-transient-major-mode mastodon + ["Timelines" + ("H" "home" mastodon-tl--get-home-timeline) + ("L" "local" mastodon-tl--get-local-timeline) + ("F" "federated" mastodon-tl--get-federated-timeline) + ("K" "bookmarks" mastodon-profile--view-bookmarks) + ("V" "favorites" mastodon-profile--view-favourites) + ("'" "followed tags" mastodon-tl--followed-tags-timeline) + ("@" "mentions" mastodon-notifications--get-mentions) + ("N" "notifications" mastodon-notifications-get) + ("\\" "of remote host" mastodon-tl--get-remote-local-timeline)] + + ;; u mastodon-tl--update + + ["Search" + ("s" "search" mastodon-search--query) + ("#" "tagged" mastodon-tl--get-tag-timeline) + ("\"" "followed tags" mastodon-tl--list-followed-tags) + ("I" "filter" mastodon-views--view-filters) + ("X" "lists" mastodon-views--view-lists)] + + ["Toots" + ("n" "next" mastodon-tl--goto-next-item :transient t) + ("p" "prev" mastodon-tl--goto-prev-item :transient t) + ("c" "spoiler" mastodon-tl--toggle-spoiler-text-in-toot :transient t) + ("T" "thread" mastodon-tl--thread) + ("b" "(un)boost" mastodon-toot--toggle-boost :transient t) + ("f" "(un)fav" mastodon-toot--toggle-favourite :transient t) + ("i" "(un)pin" mastodon-toot--pin-toot-toggle :transient t) + ("k" "(un)bookmark" mastodon-toot--toggle-bookmark :transient t) + ("v" "vote" mastodon-tl--poll-vote)] + + ;; Z mastodon-tl--report-to-mods + ;; o mastodon-toot--open-toot-url + + ["Own Toots" + ("r" "replay" mastodon-toot--reply) + ("t" "write" mastodon-toot) + ("e" "edit" mastodon-toot--edit-toot-at-point) + ("d" "delete" mastodon-toot--delete-toot) + ("D" "del & redraft" mastodon-toot--delete-and-redraft-toot) + ("E" "show edits" mastodon-toot--view-toot-edits)] + + ;; S mastodon-views--view-scheduled-toots + + ["Users" + ("W" "follow" mastodon-tl--follow-user) + ("R" "follow req" mastodon-views--view-follow-requests) + ("G" "suggestions" mastodon-views--view-follow-suggestions) + ("M" "mute user" mastodon-tl--mute-user) + ("B" "block user" mastodon-tl--block-user) + ("m" "message user" mastodon-tl--dm-user) + ;; "" + ;; ("," "favouriters" mastodon-toot--list-toot-favouriters) + ;; ("." "boosters" mastodon-toot--list-toot-boosters) + ] + + ;; S-RET mastodon-tl--unmute-user + ;; C-S-b mastodon-tl--unblock-user + + ["Profiles" + ("A" "author" mastodon-profile--get-toot-author) + ("P" "any user" mastodon-profile--show-user) + ("O" "own" mastodon-profile--my-profile) + ("U" "update own" mastodon-profile--update-user-profile-note)] + + ["Misc" + ("C" "copy URL" mastodon-toot--copy-toot-url) + ("?" "help" describe-mode) + ("q" "quit" transient-quit-one)]) + +;;;; startup +(defun jao-chats (&optional p) + (interactive "P") + (when (or p (y-or-n-p "Connect to telegram? ")) + (telega)) + (when (and (fboundp 'ement-connect) (or p (y-or-n-p "Connect to matrix? "))) + (unless (get-buffer "*Ement Rooms*") + (jao-with-auth "matrix.org" u p (ement-connect :user-id u :password p)))) + (when (and (fboundp 'mastodon) (or p (y-or-n-p "Connect to mastodon? "))) + (mastodon)) + (dolist (c '(("Libera Chat" . "irc.libera.chat:6697") + ("bigml" . "127.0.0.1:9007") + ("recoveryou" . "127.0.0.1:9008") + ("grio" . "127.0.0.1:9009"))) + (unless (get-buffer (cdr c)) + (when (or p (y-or-n-p (format "Connect to %s? " (car c)))) + (circe (car c)))))) + +(defun jao-all-chats () + (interactive) + (when jao-tracking-use-scratch + (jao-afio-goto-chats) + (delete-other-windows)) + (jao-chats t)) + +(defun jao-chats-telega () + (interactive) + (jao-buffer-same-mode '(telega-root-mode telega-chat-mode))) + +(defun jao-chats-slack () + (interactive) + (jao-buffer-same-mode 'slack-message-buffer-mode)) + +(defun jao-chats-irc () + (interactive) + (jao-buffer-same-mode '(circe-channel-mode circe-query-mode erc-mode))) + +;;;; consult narrowing +(defvar jao-chat-buffer-source + (list :name "chats" + :category 'buffer + :action (lambda (b) (jao-afio-pop-to-buffer 0 b)) + :hidden t + :narrow (cons ?c "chats") + :items (jao-consult--mode-buffers 'erc-mode + 'circe-channel-mode + 'circe-query-mode + 'signel-chat-mode + 'slack-message-buffer-mode + 'slack-thread-message-buffer-mode + 'telega-root-mode + 'telega-chat-mode + 'ement-room-mode + 'ement-room-list-mode))) +(with-eval-after-load "consult" + (jao-consult-add-buffer-source 'jao-chat-buffer-source)) +;;; Multimedia +;;;; video +(use-package ready-player :ensure t) +(ready-player-mode 1) +;;;; mixer +(defun jao-mixer-get-level (&optional dev nomsg) + (interactive) + (let* ((dev (or dev "Master")) + (s (shell-command-to-string (format "amixer sget %s" dev))) + (s (car (last (split-string s "\n" t))))) + (when (string-match ".*Front .*\\[\\([0-9]+\\)%\\] .*" s) + (let ((level (match-string 1 s))) + (unless nomsg (message "%s level: %s%%" dev level)) + (string-to-number level))))) + +(defun jao-mixer-set (dev v) + (jao-shell-exec* t "amixer" "sset" dev v) + (jao-mixer-get-level dev)) + +(defun jao-mixer-master-toggle () + (interactive) + (jao-mixer-set "Master" "toggle")) + +(defun jao-mixer-master-up () + (interactive) + (jao-mixer-set "Master" "10%+")) + +(defun jao-mixer-master-down () + (interactive) + (jao-mixer-set "Master" "10%-")) + +(defun jao-mixer-capture-up () + (interactive) + (jao-mixer-set "Capture" "10%+")) + +(defun jao-mixer-capture-down () + (interactive) + (jao-mixer-set "Capture" "10%-")) + +(jao-shell-def-exec jao-audio-applet "pasystray") + +(defun jao-toggle-audio-applet () + (interactive) + (or (jao-shell-kill-p "paystray") (jao-audio-applet))) + +(global-set-key (kbd "<f4>") #'jao-toggle-audio-applet) + +;;;; streaming aliases +(defalias 'jao-streaming-list #'ignore) +(defalias 'jao-streaming-like #'ignore) +(defalias 'jao-streaming-dislike #'ignore) +(defalias 'jao-streaming-toggle-shuffle #'ignore) +(defalias 'jao-streaming-lyrics #'ignore) +(defalias 'jao-streaming-toggle #'ignore) +(defalias 'jao-streaming-next #'ignore) +(defalias 'jao-streaming-prev #'ignore) +(defalias 'jao-streaming-current #'ignore) +(defalias 'jao-streaming-seek #'ignore) +(defalias 'jao-streaming-seek-back #'ignore) +(defalias 'jao-streaming-volume #'ignore) +(defalias 'jao-streaming-volume-down #'ignore) + +;;;; mpris +(defun jao-mpris-lyrics (&optional force) + (interactive "P") + (jao-show-lyrics force #'jao-mpris-artist-title)) + +(defun jao-mpris-mopidy-p () (string= "mopidy "jao-mpris-player)) + +(defun jao-mpc-mopidy-playlist () + (interactive) + (jao-mpc-show-playlist jao-mopidy-port)) + +(use-package jao-mpris :demand t) + +(defun jao-mpris-setup-aliases () + (setq espotify-play-uri-function #'espotify-play-uri-with-dbus) + ;; (setq jao-mpris-player "mopidy") + (defalias 'jao-streaming-list #'jao-mpc-mopidy-playlist) + (defalias 'jao-streaming-lyrics #'jao-mpris-lyrics) + (defalias 'jao-streaming-toggle #'jao-mpris-play-pause) + (defalias 'jao-streaming-next #'jao-mpris-next) + (defalias 'jao-streaming-prev #'jao-mpris-previous) + (defalias 'jao-streaming-current #'jao-mpris-show-osd) + (defalias 'jao-streaming-seek #'jao-mpris-seek) + (defalias 'jao-streaming-seek-back #'jao-mpris-seek-back) + (defalias 'jao-streaming-volume #'jao-mpris-vol) + (defalias 'jao-streaming-volume-down #'jao-mpris-vol-down)) + +(jao-mpris-register "playerctld" :session 70) +;; (jao-mpris-register "mopidy" :session 70) + +;;;; mpc +(use-package jao-mpc + :demand t + :commands jao-mpc-setup) + +(defvar jao-mopidy-port 6669) +(defvar jao-mpc-last-port jao-mpc-port) + +(defun jao-mpc-toggle-port () + (interactive) + (setq jao-mpc-port + (if (equal jao-mpc-port jao-mopidy-port) 6600 jao-mopidy-port) + jao-mpc-last-port jao-mpc-port)) + +(defsubst jao-mpc-mopidy-p () (equal jao-mpc-last-port jao-mopidy-port)) + +(jao-mpc-setup jao-mopidy-port 70) + +(defun jao-mpc-pport (&optional mop) + (cond ((or mop (jao-mpc-playing-p jao-mopidy-port)) jao-mopidy-port) + ((jao-mpc-playing-p) 6600) + (t jao-mpc-last-port))) + +(defmacro jao-defun-play (name &optional mpc-name) + (let ((arg (gensym))) + `(defun ,(intern (format "jao-player-%s" name)) (&optional ,arg) + (interactive "P") + (,(intern (format "jao-mpc-%s" (or mpc-name name))) + (setq jao-mpc-last-port (jao-mpc-pport ,arg)))))) + +(jao-defun-play toggle) +(jao-defun-play next) +(jao-defun-play previous) +(jao-defun-play stop) +(jao-defun-play echo echo-current-times) +(jao-defun-play list show-playlist) +(jao-defun-play info lyrics-track-data) +(jao-defun-play browse show-albums) +(jao-defun-play select-album) + +(defun jao-player-seek (delta) (jao-mpc-seek delta (jao-mpc-pport))) + +(defalias 'jao-player-connect 'jao-mpc-connect) +(defalias 'jao-player-play 'jao-mpc-play) + +;;;; spotify +(jao-load-path "espotify") + +(use-package espotify + :demand t + :init (setq espotify-service-name "mopidy")) + +(use-package consult-spotify :demand t) + +(defalias 'jao-streaming-album #'consult-spotify-album) +(defalias 'jao-streaming-track #'consult-spotify-track) +(defalias 'jao-streaming-artist #'consult-spotify-artist) +(defalias 'jao-streaming-playlist #'consult-spotify-playlist) + +(jao-def-exec-in-term "ncmpcpp" "ncmpcpp" (jao-afio-goto-scratch)) + +;;;; spt +(use-package jao-spt + :demand t + :config + (defun jao-spt-setup-aliases () + (setq espotify-play-uri-function #'jao-spt-play-uri) + (defalias 'jao-streaming-list #'jao-term-spt) + (defalias 'jao-streaming-lyrics #'jao-spt-show-lyrics) + (defalias 'jao-streaming-toggle #'jao-spt-toggle) + (defalias 'jao-streaming-next #'jao-spt-next) + (defalias 'jao-streaming-prev #'jao-spt-previous) + (defalias 'jao-streaming-current #'jao-spt-echo-current) + (defalias 'jao-streaming-seek #'jao-spt-seek) + (defalias 'jao-streaming-seek-back #'jao-spt-seek-back) + (defalias 'jao-streaming-volume #'jao-spt-vol) + (defalias 'jao-streaming-volume-down #'jao-spt-vol-down) + (defalias 'jao-streaming-like #'jao-spt-like) + (defalias 'jao-streaming-dislike #'jao-spt-dislike) + (defalias 'jao-streaming-toggle-shuffle #'jao-spt-toggle-shuffle))) + +(jao-def-exec-in-term "spt" "spt" (jao-afio-goto-scratch)) + +(defvar jao-spt-on t) + +(defun jao-streaming-toggle-player () + (interactive) + (if jao-spt-on + (progn (setq jao-mpris-player "playerctld") + (require 'jao-mpris) + (jao-mpris-setup-aliases)) + (jao-spt-setup-aliases) + (setq jao-mpris-player "spt")) + (setq jao-spt-on (not jao-spt-on)) + (message "%s activated " jao-mpris-player)) + +(jao-streaming-toggle-player) + +;;;; music transients +(require 'jao-lyrics) +(setq jao-lyrics-info-function #'jao-player-info) + +(defun jao-player-seek-10 () (interactive) (jao-player-seek 10)) +(defun jao-player-seek--10 () (interactive) (jao-player-seek -10)) + +(defun jao-streaming-clear () (interactive) (jao-mpc-clear jao-mopidy-port)) + +(defun jao-streaming-echo-current () + (interactive) + (jao-mpc-echo-current jao-mopidy-port)) + +(defun jao-streaming-show-playlist () + (interactive) + (jao-mpc-show-playlist jao-mopidy-port)) + +(use-package jao-random-album + :demand t + :config + (defun jao--notify-album (album) + (unless jao-minibuffer-mode + (jao-notify album "Next album" jao-notify-audio-icon)) + (jao-minibuffer-refresh)) + (setq jao-random-album-notify #'jao--notify-album)) + +(defun jao-toggle-pasystray-applet () + (interactive) + (or (jao-shell-kill-p "pasystray") (jao-shell-exec "pasystray"))) + +(transient-define-prefix jao-transient-streaming () + [:description + (lambda () (format "Streaming using %s" jao-mpris-player)) + ["Search" :if jao-mpris-mopidy-p + ("a" "album" jao-streaming-album) + ("A" "artist" jao-streaming-artist) + ("t" "track" jao-streaming-track) + ("P" "playlist" jao-streaming-playlist)] + ["Play" + ("s" "toggle" jao-streaming-toggle) + ("n" "next" jao-streaming-next) + ("p" "previous" jao-streaming-prev) + ("T" "toggle player" jao-streaming-toggle-player)] + ["Seek & shout" + ("f" "seek fwd" jao-streaming-seek :transient t) + ("F" "seek bwd" jao-streaming-seek-back :transient t) + ("u" "up" jao-streaming-volume :transient t) + ("d" "down" jao-streaming-volume-down :transient t)] + ["Browse" + ("l" "playing list" jao-streaming-list :if jao-mpris-mopidy-p) + ("L" "lyrics" jao-streaming-lyrics) + ("w" "currently playing" jao-streaming-current)] + ["Act" :if jao-mpris-mopidy-p + ("k" "like" jao-streaming-like) + ("K" "dislike" jao-streaming-dislike) + ("S" "toggle shuffle" jao-streaming-toggle-shuffle)]]) + +(transient-define-prefix jao-transient-media () + [["Play" + ("m" "toggle" jao-player-toggle) + ("n" "next" jao-player-next) + ("p" "previous" jao-player-previous) + ("s" "select album" jao-player-select-album)] + ["Seek and search" + ("f" "seek fwd" jao-player-seek-10 :transient t) + ("F" "seek bwd" jao-player-seek--10 :transient t) + ("a" "search album" jao-mpc-select-album) + ("S" "play stream" jao-mpc-play-stream)] + ["Browse" + ("b" "browse" jao-player-browse) + ("l" "show play list" jao-player-list) + ("L" "show lyrics" jao-show-lyrics) + ("w" "now playing" jao-player-echo)] + [:description + (lambda () + (message "%s %s" + (if (jao-mpc-mopidy-p) "mopidy" "mpd") + (if (jao-mpc-playing-p) + (jao-mpc--current-timestr t) + (jao-mpc--current-str))) + (format "Master %s%%" (jao-mixer-get-level nil t))) + ("d" "down" jao-mixer-master-down :transient t) + ("u" "up" jao-mixer-master-up :transient t) + ("M" "toggle" jao-mixer-master-toggle)] + [:description + (lambda () (format "Capture %s%%" (jao-mixer-get-level "Capture" t))) + ("D" "down" jao-mixer-capture-down :transient t) + ("U" "up" jao-mixer-capture-up :transient t)] + ["Utilities" + ("c" "reconnect to mpd" jao-player-connect) + ("N" "next random album" jao-random-album-next) + ("r" (lambda () + (concat (if jao-random-album-active "dis" "en") "able random album")) + jao-random-album-toggle) + ;; ("P" (lambda () (concat "Toggle to " (if (jao-mpc-mopidy-p) "mpd" "mopidy"))) + ;; jao-mpc-toggle-port) + ("P" "pasystray" jao-toggle-pasystray-applet)]]) + +(global-set-key (kbd "s-m") #'jao-transient-media) + +;;; Graphical window system +;;;; x11 utils +(defun jao-xdotool (arg-or-wait &rest args) + (apply 'jao-shell-exec* + (if (stringp arg-or-wait) "xdotool" arg-or-wait) + (if (stringp arg-or-wait) arg-or-wait "xdotool") + args)) + +(defsubst jao-xdotool-string (&rest args) + (apply 'jao-shell-string "xdotool" args)) + +(defsubst jao-x11-focused-id () (jao-xdotool-string "getwindowfocus")) + +(defsubst jao-x11-window-name (&optional wid) + (jao-xdotool-string "getwindowname" (or wid (jao-x11-focused-id)))) + +(defsubst jao-x11-search-window (title) + (jao-xdotool-string "search" "--name" title)) + +(defsubst jao-x11-goto-ws (n) (jao-xdotool t "set_desktop" (format "%s" n))) + +;;;; exwm +(defvar jao-exwm-enabled nil) +(defun jao-exwm-enabled-p () jao-exwm-enabled) + +(defun jao-exwm-enable () + (require 'jao-custom-exwm) + (setq jao-exwm-enabled t) + (display-time-mode -1) + (jao-ednc-setup 95) + (exwm-enable) + (x-change-window-property "_XMONAD_TRAYPAD" "" nil nil nil nil 0) + (jao-mode-line-add-to-minibuffer-left 90) + (jao-xmobar-restart) + (jao-trisect t)) + +;;;; xmonad +(defvar jao-xmonad-enabled (string= "xmonad" (or (getenv "wm") ""))) +(defun jao-xmonad-enabled-p () jao-xmonad-enabled) + +(defun jao-xmonad-enable () + (setq jao-browse-doc-use-emacs-p (display-graphic-p)) + (setq jao-mode-line-in-minibuffer nil) + (display-battery-mode -1) + (jao-trisect) + (message "Welcome to xmonad")) + +(when jao-xmonad-enabled + (add-hook 'after-init-hook #'jao-xmonad-enable)) + +;;;; wayland + +(use-package jao-wayland :demand t) + +(defun jao-wayland-enable () + (interactive) + (defalias 'x-change-window-property #'ignore) + (jao-trisect) + (message "Welcome to wayland")) + +(defun jao-river-enable () + (jao-wayland-enable) + (when (jao-shell-running-p "i3bar-river") + (jao-tracking-set-log "")) + (message "Welcome to river")) + +(when jao-river-enabled + (add-hook 'after-init-hook #'jao-river-enable t)) + +(when jao-sway-enabled + (add-hook 'after-init-hook #'jao-wayland-enable t)) + +;;;; wallpaper +(defvar jao-wallpaper-dir "~/.wallpapers/") + +(defvar jao-wallpaper-random-candidates + '("wallpaper.jpg" "wallpaper2.jpg")) + +(defvar jao-wallpaper-random-candidates-light + '("wallpaper.jpg" "wallpaper2.jpg")) + +(defvar jao-wallpaper-random-wake t + "Set to t for getting a new wallpaper on awaking from sleep") + +(defun jao-set-wallpaper (&optional path) + (interactive) + (let ((current (format "~/.wallpaper.%s" (jao-colors-scheme)))) + (when-let ((f (or (and path (expand-file-name path)) + (read-file-name "Image: " + jao-wallpaper-dir + (file-symlink-p current) + t)))) + (make-symbolic-link f current t) + (cond (jao-river-enabled (jao-river-set-wallpaper f)) + (jao-sway-enabled (jao-sway-set-wallpaper f)) + (t (shell-command-to-string (format "xwallpaper --zoom %s" f))))))) + +(defun jao-set-random-wallpaper () + (interactive) + (when (or (called-interactively-p 'interactive) + jao-wallpaper-random-wake) + (let* ((ws (if (jao-colors-scheme-dark-p) + jao-wallpaper-random-candidates + jao-wallpaper-random-candidates-light)) + (f (seq-random-elt ws))) + (jao-set-wallpaper (expand-file-name f jao-wallpaper-dir)) + (message "%s" f)))) + +(add-to-list 'jao-sleep-awake-functions #'jao-set-random-wallpaper) + +;;;; screensaver and lock +(defun jao-screensaver-enabled () + (string= (jao-shell-string "xdg-screensaver status") "enabled")) + +(defvar jao-screensaver--wid nil) +(defun jao-screensaver-toggle () + (interactive) + (if (jao-screensaver-enabled) + (let ((wid (jao-x11-focused-id))) + (setq jao-screensaver--wid wid) + (jao-shell-exec* t "xdg-screensaver" "suspend" wid)) + (jao-shell-exec* t "xdg-screensaver" "resume" jao-screensaver--wid) + (setq jao-screensaver--wid nil)) + (jao-notify (format "Screensaver %s" + (jao-shell-string "xdg-screensaver status")))) + +(jao-shell-def-exec jao-xlock-screen "xdg-screensaver" "activate") +(jao-shell-def-exec jao-suspend "sudo" "systemctl" "suspend") +(jao-shell-def-exec jao-poweroff "sudo" "systemctl" "poweroff") + +(defun jao-lock-screen () + (interactive) + (if jao-wayland-enabled + (shell-command "swaylock -i ~/.lockimage") + (jao-xlock-screen))) + +(transient-define-prefix jao-transient-sleep () + ["Sleep" + ("l" "lock screen" jao-lock-screen) + ("z" "sleep" jao-suspend) + ("u" (lambda () + (if (jao-screensaver-enabled) "suspend screensaver" "resume screensaver")) + jao-screensaver-toggle) + ("poof" "power-off" jao-poweroff)]) + +;;;; X clipboard +(setq select-enable-clipboard t + select-enable-primary t + selection-timeout 100 + xterm-select-active-regions t) + +(use-package xclip + :ensure t + :init (setq xclip-method (if jao-wayland-enabled 'wl-copy 'xclip))) + +(unless (display-graphic-p) (xclip-mode 1)) + +;;;; pop-up frames +(defun jao-open-in-x-frame (&optional width height) + (interactive) + (make-frame `((window-system . x) + (name . "emacs popup") + (width . ,(or width (window-width))) + (height . ,(or height (window-height))))) + (define-key (current-local-map) "q" #'delete-frame)) + +;;;; xmobar +(defun jao-xmobar-kill () + (interactive) + (shell-command "killall xmobar-single")) + +(defun jao-xmobar-restart () + (interactive) + (jao-xmobar-kill) + (start-process "" nil "xmobar-single" "-d")) + +(use-package tab-bar + :init (setq tab-bar-close-button-show nil + tab-bar-show (> emacs-major-version 28) + tab-bar-format ())) + +(use-package xmobar + :init (setq xmobar-tab-bar t + xmobar-tab-split "*" + xmobar-tab-bar-format + (if window-system + '(xmobar-left-string + tab-bar-format-align-right + xmobar-right-string) + '(xmobar-left-string + xmobar-elastic-space + xmobar-right-string)) + xmobar-command + (if window-system '("xmobar-emacs" "-TAnsi") "xmobar-emacs"))) + +;;; Global transients +(defun jao-list-packages () + (interactive) + (jao-afio-goto-scratch) + (package-list-packages)) + +(defun jao-window-system-p () + (or jao-exwm-enabled jao-xmonad-enabled jao-wayland-enabled)) + +(defun jao-x11-p () (or jao-exwm-enabled jao-xmonad-enabled)) + +(defun jao-reveal () + (interactive) + (cond ((or outline-minor-mode (derived-mode-p 'outline-mode )) + (outline-show-entry)) + ((derived-mode-p 'org-mode) (org-reveal)))) + +(jao-def-exec-in-term "aptitude" "aptitude" (jao-afio-goto-scratch)) +(jao-def-exec-in-term "htop" "htop" (jao-afio-goto-scratch)) + +(transient-define-prefix jao-transient-utils () + "Global operations." + [["Notes" + ("n" "create new note" jao-org-notes-create) + ("/" "open note" jao-org-notes-open) + ("\\" "open note by tags" jao-org-notes-consult-tags) + ("g" "ripgrep notes" jao-org-notes-consult-ripgrep)] + ["Documents" + ("dd" "go to doc" jao-select-pdf :if display-graphic-p) + ("do" "open doc" jao-open-doc) + ("dr" "search docs with recoll" jao-recoll-consult-docs)] + ["Monitors" + ("p" "list projects" list-projects) + ;; ("p" "htop" jao-term-htop) + ("P" "pasytray" jao-toggle-pasystray-applet) + ("x" "restart i3bar" jao-river-restart-i3bar :if jao-river-enabled-p) + ("x" "restart xmobar" jao-xmobar-restart :if jao-exwm-enabled-p) + ("x" "kill xmobar" jao-xmobar-kill :if jao-xmonad-enabled-p)] + ["Network" + ("s" "ssh" jao-ssh) + ("b" "bluetooth" bluetooth-list-devices) + ("c" "connect chats" jao-all-chats) + ("m" "proton bridge" run-proton-bridge) + ("v" "view video" jao-view-video)] + ["Chats" + ("t" "telegram" jao-chats-telega) + ("i" "irc" jao-chats-irc) + ("M" "mastodon" jao-mastodon) + ("T" "telegram rooster" jao-telega)] + ["Window system" :if jao-window-system-p + ("w" "set wallpaper" jao-set-wallpaper) + ("W" "set radom wallpaper" jao-set-random-wallpaper) + ("B u" (lambda () + (let ((b (jao-brightness))) + (format "bright up %s" (and (string-match ".*\\((.+)\\).*" b) + (match-string 1 b))))) + jao-bright-up :transient t) + ("B d" "bright down" jao-bright-down :transient t)] + ["Helpers" + ("a" "aptitude" jao-term-aptitude) + ("l" "packages" jao-list-packages) + ;; ("r" "reveal" jao-reveal) + ("r" "translate" reverso) + ("f" "copy buffer file name" copy-buffer-file-name-as-kill) + ("k" (lambda () (concat "keyboard" (when (jao-kb-toggled-p) "*"))) + jao-kb-toggle :if jao-x11-p)]]) + +(global-set-key (kbd "s-w") #'jao-transient-utils) + +;;; Global key bindings +(defun jao-global-keybindings () + (interactive) + (global-set-key (kbd "<f2>") #'magit-status) + (global-set-key (kbd "C-x p") #'jao-prev-window) + (global-set-key (kbd "C-x o") 'other-window) + (global-set-key "\C-cj" #'join-line) + (global-set-key "\C-cn" #'next-error) + (global-set-key "\C-cq" #'auto-fill-mode) + (global-set-key "\C-xr\M-w" #'kill-rectangle-save) + (global-set-key "\C-c\C-z" #'comment-or-uncomment-region) + (global-set-key "\C-z" #'comment-or-uncomment-region)) + +(jao-global-keybindings) + +;;; Last minute (post.el) +(jao-load-site-el "post") diff --git a/init.org b/init.org deleted file mode 100644 index 5d9de8e..0000000 --- a/init.org +++ /dev/null @@ -1,3527 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t -*-" :tangle-mode (identity #o644) - -* Packages -*** Use package - #+begin_src emacs-lisp - (unless (package-installed-p 'use-package) - (package-refresh-contents) - (package-install 'use-package)) - (require 'use-package) - #+end_src -*** ELPA Keyring - #+begin_src emacs-lisp - (use-package gnu-elpa-keyring-update :ensure t) - #+end_src -*** Loading .el newer than .elc files, and eln stuff - #+begin_src emacs-lisp - (setq load-prefer-newer t) - (setq comp-async-report-warnings-errors nil - warning-suppress-types '((comp))) - #+end_src -* Initialisation -*** Paths - #+begin_src emacs-lisp - (defvar jao-local-lisp-dir "~/lib/elisp" - "Directory for external elisp libraries and repos") - - (defvar jao-data-dir (expand-file-name "data" jao-emacs-dir) - "Directory containing static data, such as images.") - - (defun jao-data-file (file) (expand-file-name file jao-data-dir)) - - (defvar jao-org-dir (expand-file-name "~/org")) - - (defvar jao-sink-dir - (file-name-as-directory (expand-file-name "~/doc/sink")) - "Directory used for downloads and such.") - - (defvar jao-site-dir (expand-file-name "site" jao-emacs-dir)) - (defun jao-site-el (basename &optional gpg) - (expand-file-name (concat basename ".el" (when gpg ".gpg")) jao-site-dir)) - - (defun jao-load-site-el (basename &optional gpg) - (let ((lf (jao-site-el basename gpg))) - (if (file-exists-p lf) - (load lf) - (message "Attempted to load non existing %s" lf)))) - - (defun jao-exec-path (file) - (let ((fn (expand-file-name file))) - (add-to-list 'exec-path fn nil) - (setenv "PATH" (concat fn ":" (getenv "PATH"))))) - - (defun jao-load-path (subdir) - "Add to load path a subdir of `jao-local-lisp-dir'" - (let ((path (expand-file-name subdir jao-local-lisp-dir))) - (when (file-directory-p path) (add-to-list 'load-path path)))) - #+end_src -*** Load and info path initialisation - #+begin_src emacs-lisp - (add-to-list 'load-path jao-site-dir) - (add-to-list 'load-path jao-local-lisp-dir) - (add-to-list 'load-path "/usr/local/share/emacs/site-lisp/") - - (let ((libd (expand-file-name "lib" jao-emacs-dir))) - (add-to-list 'load-path libd) - (dolist (f (directory-files libd t "^[^.]+$")) - (when (file-directory-p f) (add-to-list 'load-path f)))) - - (defvar jao-info-dir (expand-file-name "~/doc/info")) - (require 'info) - (add-to-list 'Info-directory-list jao-info-dir) - #+end_src -*** Custom location of custom.el and co. - #+begin_src emacs-lisp - (setq custom-file (jao-site-el "custom")) - ;; (load custom-file) - (setq custom-unlispify-tag-names nil) - (setq custom-buffer-done-kill t) - (setq custom-raised-buttons nil) - #+end_src -*** Preamble (pre.el) - #+begin_src emacs-lisp - (jao-load-site-el "pre") - #+end_src -*** Session and history - #+BEGIN_SRC emacs-lisp - (setq backup-directory-alist (quote (("." . "~/.emacs.d/backups")))) - (setq delete-old-versions t - kept-new-versions 3 - kept-old-versions 2) - - (require 'saveplace) - (setq save-place-file (expand-file-name "~/.emacs.d/cache/places")) - (save-place-mode 1) - - (setq recentf-save-file (expand-file-name "~/.emacs.d/cache/recentf") - recentf-max-saved-items 2000 - recentf-exclude '("/home/jao/\\.emacs\\.d/elpa.*/.*" - ".*/.git/COMMIT_EDITMSG")) - (require 'recentf) - (recentf-mode 1) - - ;; Command history - (setq savehist-file (expand-file-name "~/.emacs.d/cache/history")) - (require 'savehist) - (savehist-mode t) - (setq savehist-additional-variables - '(kill-ring search-ring regexp-search-ring) - savehist-ignored-variables - '(ido-file-history)) - #+END_SRC -*** yes/no, bell, startup message - #+BEGIN_SRC emacs-lisp - ;;; change yes/no for y/n - (if (version< emacs-version "28") - (fset 'yes-or-no-p 'y-or-n-p) - (setq use-short-answers t)) - (setq inhibit-startup-message t) - (setq visible-bell t) - #+END_SRC -*** Server - #+begin_src emacs-lisp - (setenv "EDITOR" "emacsclient") - ;; (unless (daemonp) (server-start)) - #+end_src -* System utilities -*** Tramp - #+begin_src emacs-lisp - (setq tramp-mode nil) - #+end_src -*** Sleep/awake - #+begin_src emacs-lisp - (use-package jao-sleep) - (jao-sleep-dbus-register) - #+end_src -*** Process runners - #+begin_src emacs-lisp - (use-package jao-shell - :demand t - :config (jao-shell-def-exec jao-trayer "trayer.sh") - :bind (("s-r" . jao-shell-exec))) - - #+end_src -*** App launcher - #+begin_src emacs-lisp - (jao-load-path "app-launcher") - (use-package app-launcher - :bind (("s-R" . app-launcher-run-app))) - #+end_src -*** Brightness control - #+begin_src emacs-lisp - (jao-shell-def-exec jao-bright-set-up "brightnessctl" "-q" "s" "5%+") - (jao-shell-def-exec jao-bright-set-down "brightnessctl" "-q" "s" "5%-") - - (defun jao-bright-show () - (interactive) - (message "%s" (thread-first (jao-shell-string "brightnessctl") - (split-string "\n") - (cadr) - (string-trim)))) - - (defun jao-bright-up () - (interactive) - (jao-shell-string "brightnessctl -q s 5%%+") - (jao-bright-show)) - - (defun jao-bright-down () - (interactive) - (jao-shell-string "brightnessctl -q s 5%%-") - (jao-bright-show)) - #+end_src -*** Keyboard - #+begin_src emacs-lisp - (use-package repeat - :config (setq repeat-echo-function #'repeat-echo-mode-line)) - (when (> emacs-major-version 27) (repeat-mode)) - - (defun jao-kb-toggle (&optional lyt) - (interactive) - (shell-command-to-string (or lyt - (if (jao-kb-toggled-p) - "setxkbmap us" - "setxkbmap us -variant intl")))) - - (defun jao-kb-toggled-p () - (not (string-empty-p - (shell-command-to-string "setxkbmap -query|grep variant")))) - - (set-keyboard-coding-system 'latin-1) - (set-language-environment "UTF-8") - ;; must be set after current-language-environment - (customize-set-variable 'default-input-method "catalan-prefix") - ;; http://mbork.pl/2022-03-07_Transient_input_method - (customize-set-variable 'default-transient-input-method "TeX") - - (defun jao--set-kb-system (frame) - (select-frame frame) - (set-keyboard-coding-system 'latin-1) - t) - (add-to-list 'after-make-frame-functions 'jao--set-kb-system) - - (setq echo-keystrokes 1 - suggest-key-bindings nil) - #+end_src -*** Transient - #+begin_src emacs-lisp - (use-package transient - :init (setq transient-show-popup t) ;; 2.0 - :demand t - :config - (transient-bind-q-to-quit)) - - (defmacro jao-transient-major-mode (mode &rest suffix) - (declare (indent defun)) - (let ((mode (intern (format "%s-mode" mode))) - (mmap (intern (format "%s-mode-map" mode))) - (name (intern (format "jao-transient-%s" mode)))) - `(progn - (transient-define-prefix ,name () - ,(format "Transient ops for %s" mode) - [,(format "Operations for %s" mode) :if-derived ',mode ,@suffix]) - (define-key ,mmap (kbd "s-SPC") #',name)))) - - (defmacro jao-transient-major-mode+1 (mode suffix) - (declare (indent defun)) - (let ((name (intern (format "jao-transient-%s" mode)))) - (if (fboundp name) - `(transient-append-suffix ',name '(0 -1) ,suffix) - `(jao-transient-major-mode ,mode ,suffix)))) - - (defmacro jao-transient-major-mode+ (mode &rest suffixes) - (declare (indent defun)) - `(progn ,@(mapcar (lambda (s) `(jao-transient-major-mode+1 ,mode ,s)) - suffixes))) - - #+end_src -*** Disk - #+begin_src emacs-lisp - (when (featurep 'multisession) - (use-package jao-dirmon)) - #+end_src -* Crypto -*** PGP, EPG, passwords - #+begin_src emacs-lisp - (setq epg-pinentry-mode 'loopback) - (setq auth-source-debug nil) - - (require 'auth-source) - (add-to-list 'auth-source-protocols '(local "local")) - (setq auth-sources '("~/.emacs.d/authinfo.gpg" "~/.netrc")) - - (use-package epa-file - :init (setq epa-file-cache-passphrase-for-symmetric-encryption t) - :config (epa-file-enable)) - (require 'epa-file) - - (defun jao--get-user/password (h) - (let ((item (car (auth-source-search :type 'netrc :host h :max 1)))) - (when item - (let ((user (plist-get item :user)) - (pwd (plist-get item :secret))) - (list user (when pwd (funcall pwd))))))) - #+end_src -*** pass - #+begin_src emacs-lisp - (use-package password-store :ensure t - :bind (("C-c p" . jao-transient-password))) - - (transient-define-prefix jao-transient-password () - [[("c" "copy secret" password-store-copy) - ("C" "copy field" password-store-copy-field)] - [("i" "insert entry" password-store-insert) - ("e" "edit entry" password-store-edit) - ("g" "generate password" password-store-generate)] - [("d" "delete entry" password-store-remove) - ("r" "rename entry" password-store-rename)]]) - - #+end_src -*** Pinentry - #+begin_src emacs-lisp - (use-package pinentry :ensure t) - (pinentry-start) - #+end_src -* Fonts and colour themes -*** Widgets - #+begin_src emacs-lisp - (setq widget-image-enable nil - widget-link-prefix "" - widget-link-suffix "" - widget-button-prefix " " - widget-button-suffix " " - widget-push-button-prefix "" - widget-push-button-suffix "") - #+end_src -*** Fonts -***** fontsets - See [[https://emacs.stackexchange.com/questions/251/line-height-with-unicode-characters/5386#5386][fonts - Line height with unicode characters]] for a good - discussion. - #+begin_src emacs-lisp - (defun jao--set-fontsets (_f) - (set-fontset-font t 64257 "Quivira" nil) - (set-fontset-font t 'egyptian "Noto Sans Egyptian Hieroglyphs" - nil) - (set-fontset-font t 'hangul "NanumGothicCoding" nil) - (set-fontset-font t 'unicode (face-attribute 'default :family) - nil) - (set-fontset-font t 'unicode-bmp (face-attribute 'default :family) - nil) - (set-fontset-font t 'symbol "Symbola-10" nil) - (set-fontset-font t 'greek "GFS Didot" nil) - (set-fontset-font t 'mathematical "FreeSerif" nil) - (set-fontset-font t 'emoji "Noto Color Emoji" nil) - ;; boxes - (set-fontset-font t '(9472 . 9599) "Source Code Pro" nil) - ;; variation selector-16 - (set-fontset-font t 65039 "BabelStone Modern-1" nil)) - - (jao--set-fontsets nil) - (add-to-list 'after-make-frame-functions 'jao--set-fontsets) - - #+end_src -***** nobreak char display - #+begin_src emacs-lisp - (setq nobreak-char-display nil) - #+end_src -***** list-fonts-display - #+begin_src emacs-lisp - (defun list-fonts-display (&optional matching) - "Display a list of font-families available via font-config, in a new buffer. - If the optional argument MATCHING is non-nil, only - font families matching that regexp are displayed; - interactively, a prefix argument will prompt for the - regexp. The name of each font family is displayed - using that family, as well as in the default font (to - handle the case where a font cannot be used to display - its own name)." - (interactive - (list - (and current-prefix-arg - (read-string "Display font families matching regexp: ")))) - (let (families) - (with-temp-buffer - (shell-command "fc-list : family" t) - (goto-char (point-min)) - (while (not (eobp)) - (let ((fam (buffer-substring (line-beginning-position) - (line-end-position)))) - (when (or (null matching) (string-match matching fam)) - (push fam families))) - (forward-line))) - (setq families - (sort families - (lambda (x y) (string-lessp (downcase x) (downcase y))))) - (let ((buf (get-buffer-create "*Font Families*"))) - (with-current-buffer buf - (erase-buffer) - (dolist (family families) - ;; We need to pick one of the comma-separated names to - ;; actually use the font; choose the longest one because some - ;; fonts have ambiguous general names as well as specific - ;; ones. - (let ((family-name - (car (sort (split-string family ",") - (lambda (x y) (> (length x) (length y)))))) - (nice-family (replace-regexp-in-string "," ", " family))) - (insert (concat (propertize nice-family - 'face (list :family family-name)) - " (" nice-family ")")) - (newline))) - (goto-char (point-min))) - (display-buffer buf)))) - #+end_src -*** Themes - #+begin_src emacs-lisp - (defun jao-colors-scheme-dark-p () - (equal "dark" (getenv "JAO_COLOR_SCHEME"))) - - (setq custom-theme-directory - (expand-file-name "lib/themes" jao-emacs-dir)) - - (require 'jao-themes) - - (defvar jao-theme-dark 'jao-dark) - (defvar jao-theme-light 'jao-light) - (defvar jao-theme-term-dark 'modus-vivendi) - (defvar jao-theme-term-light 'jao-light) - - (defun jao-themes-setup () - (let* ((dark (jao-colors-scheme-dark-p)) - (theme (cond ((and dark window-system) jao-theme-dark) - (dark jao-theme-term-dark) - (window-system jao-theme-light) - (t jao-theme-term-light)))) - (load-theme theme t) - (modify-all-frames-parameters `((font . ,jao-themes-default-face))))) - - (unless (eq window-system 'pgtk) (jao-themes-setup)) - - (global-font-lock-mode 1) - #+end_src -* Help system -*** Help buffers and shortcuts - #+begin_src emacs-lisp - (setq help-window-select t - help-link-key-to-documentation t) - - (use-package find-func - :bind (("C-h C-v" . find-variable) - ("C-h C-f" . find-function) - ("C-h C-k" . find-function-on-key) - ("C-h C-l" . find-library))) - #+end_src -*** eldoc - #+begin_src emacs-lisp - (use-package eldoc - :init (setq eldoc-mode-line-string nil - eldoc-echo-area-use-multiline-p t - eldoc-echo-area-prefer-doc-buffer nil - eldoc-display-functions '(eldoc-display-in-echo-area)) - :config (global-eldoc-mode 1) - :diminish ((eldoc-mode . ""))) - #+end_src -*** Bookmarks - #+begin_src emacs-lisp - (setq bookmark-default-file "~/.emacs.d/emacs.bmk" - bookmark-set-fringe-mark nil) - - #+end_src -*** Man pages - #+begin_src emacs-lisp - (setq Man-notify-method 'pushy) ;; pushy - same window - #+end_src -*** Recoll - #+begin_src emacs-lisp - (use-package jao-recoll) - #+end_src -* Window manager helpers -*** transparency - #+begin_src emacs-lisp - (defvar jao-transparent-only-bg (> emacs-major-version 28)) - - (defvar jao-frames-default-alpha - (cond ((eq window-system 'pgtk) 80) - (jao-transparent-only-bg 88) - (t 85))) - - (defvar jao-transparent-frame (< jao-frames-default-alpha 100)) - - (defun jao-transparent-p () jao-transparent-frame) - - (defun jao-alpha-parameters (&optional level) - (let ((level (or level jao-frames-default-alpha))) - (if jao-transparent-only-bg - `((alpha-background . ,level) (alpha)) - `((alpha . ,(cons level level)) (alpha-background))))) - - (defun jao-set-transparency (&optional level all) - (interactive "nOpacity (0-100): ") - (let ((level (or level jao-frames-default-alpha))) - (setq jao-transparent-frame (< level 100)) - (if all - (modify-all-frames-parameters (jao-alpha-parameters level)) - (modify-frame-parameters nil (jao-alpha-parameters level))))) - - (defun jao-toggle-transparency (&optional all) - (interactive "P") - (let ((level (if jao-transparent-frame 100 jao-frames-default-alpha))) - (jao-set-transparency level all))) - - #+end_src -*** exwm - #+begin_src emacs-lisp - (defvar jao-exwm-enabled nil) - (defun jao-exwm-enabled-p () jao-exwm-enabled) - - (defun jao-exwm-enable () - (jao-load-org "exwm.org") - (setq jao-exwm-enabled t) - (display-time-mode -1) - (exwm-enable) - (setq jao-frames-default-alpha 88) - (jao-set-transparency) - (x-change-window-property "_XMONAD_TRAYPAD" "" nil nil nil nil 0) - (jao-trisect t)) - #+end_src -*** xmonad - #+begin_src emacs-lisp - (defvar jao-xmonad-enabled (string= "xmonad" (or (getenv "wm") ""))) - (defun jao-xmonad-enabled-p () jao-xmonad-enabled) - - (defun jao-xmonad-enable () - (setq jao-browse-doc-use-emacs-p t) - (setq jao-wallpaper-random-wake t) - (jao-set-transparency) - (jao-trisect) - (message "Welcome to xmonad")) - - (when jao-xmonad-enabled - (add-hook 'after-init-hook #'jao-xmonad-enable t)) - - #+end_src -*** sway - When starting emacs inside a sway session, we use ~-f - jao-sway-enable~ and don't load any separate configuration file. - - #+begin_src emacs-lisp - (defun jao-swaymsg (msg) - (shell-command (format "swaymsg '%s' >/dev/null" msg))) - - (defmacro jao-def-swaymsg (name msg) - `(defun ,(intern (format "jao-sway-%s" name)) () - (interactive) - (jao-swaymsg ,msg))) - (jao-def-swaymsg firefox "[app_id=firefox] focus") - - (defvar jao-sway-enabled - (and (eq window-system 'pgtk) (not jao-xmonad-enabled))) - - (defun jao-sway-set-wallpaper (f) - (jao-swaymsg (format "output * bg %s fill" f)) - (make-symbolic-link f "~/.wallpaper.sway" t)) - - (defun jao-sway-run-or-focus (cmd &optional ws) - (if (jao-shell-running-p "firefox") - (jao-swaymsg (format "[app_id=%s] focus" cmd)) - (jao-swaymsg (format "workspace %s" (or ws 2))) - (start-process-shell-command cmd nil cmd))) - - (defun jao-sway-run-or-focus-deezer () - (interactive) - (if (jao-shell-running-p "deezer-desktop") - (jao-swaymsg "[app_id=Deezer] scratchpad show") - (start-process-shell-command "deezer" nil "deezer &") - (jao-sway-run-or-focus-deezer))) - - (defun jao-sway-run-or-focus-firefox () - (interactive) - (jao-sway-run-or-focus "firefox")) - - (defun jao-sway-enable () - (setq jao-browse-doc-use-emacs-p t) - (setq jao-wallpaper-random-wake nil) - (jao-trisect) - (jao-set-transparency 85) - (jao-themes-setup) - ;; (display-time-mode 1) - (global-set-key (kbd "s-f") #'jao-sway-run-or-focus-firefox) - (message "Welcome to sway")) - - (when jao-sway-enabled - (defalias 'x-change-window-property #'ignore) - (add-hook 'after-init-hook #'jao-sway-enable)) - - #+end_src -*** detect ws - #+begin_src emacs-lisp - (defvar jao-window-system - (or jao-exwm-enabled jao-xmonad-enabled jao-sway-enabled)) - (defun jao-window-system-p () jao-window-system) - #+end_src -*** wallpaper - #+begin_src emacs-lisp - (defvar jao-wallpaper-dir "~/.wallpapers/") - - (defvar jao-wallpaper-random-candidates - '("wallpaper.jpg" "wallpaper2.jpg")) - - (defvar jao-wallpaper-random-candidates-light - '("wallpaper.jpg" "wallpaper2.jpg")) - - (defvar jao-wallpaper-random-wake t - "Set to t for getting a new wallpaper on awaking from sleep") - - (defun jao-set-wallpaper (&optional path) - (interactive) - (let ((current (format "~/.wallpaper.%s" - (if (jao-colors-scheme-dark-p) "dark" "light")))) - (when-let ((f (or path - (read-file-name "Image: " - jao-wallpaper-dir - (file-symlink-p current) - t)))) - (make-symbolic-link (expand-file-name f) current t) - (if jao-sway-enabled - (jao-sway-set-wallpaper (expand-file-name f)) - (shell-command (format "xwallpaper --zoom %s" f)))))) - - (defun jao-set-random-wallpaper () - (interactive) - (when (or (called-interactively-p 'interactive) - jao-wallpaper-random-wake) - (let* ((ws (if (jao-colors-scheme-dark-p) - jao-wallpaper-random-candidates - jao-wallpaper-random-candidates-light)) - (f (seq-random-elt ws))) - (jao-set-wallpaper (expand-file-name f jao-wallpaper-dir)) - (message "%s" f)))) - - (add-to-list 'jao-sleep-awake-functions #'jao-set-random-wallpaper) - #+end_src -*** screensaver and lock - #+begin_src emacs-lisp - (defun jao-screensaver-enabled () - (string= (jao-shell-string "xdg-screensaver status") "enabled")) - - (defun jao-screensaver-toggle () - (interactive) - (let ((wid (jao-shell-string "xdotool getwindowfocus"))) - (if (jao-screensaver-enabled) - (jao-shell-string "xdg-screensaver suspend" wid) - (jao-shell-string "xdg-screensaver resume" wid)) - (jao-notify (format "Using '%s'" - (jao-shell-string "xdotool getwindownames" wid)) - (format "Screensaver %s" - (jao-shell-string "xdg-screensaver status"))))) - - (jao-shell-def-exec jao-xlock-screen "xdg-screensaver" "activate") - (jao-shell-def-exec jao-suspend "sudo" "systemctl" "suspend") - (jao-shell-def-exec jao-poweroff "sudo" "systemctl" "poweroff") - - (defun jao-lock-screen () - (interactive) - (if jao-sway-enabled - (shell-command "swaylock -i ~/.lockimage") - (jao-xlock-screen))) - - (transient-define-prefix jao-transient-sleep () - ["Sleep" - ("l" "lock screen" jao-lock-screen) - ("z" "sleep" jao-suspend) - ("u" "enable/disable screensaver" jao-screensaver-toggle) - ("poof" "power-off" jao-poweroff)]) - - #+end_src -*** mouse - #+begin_src emacs-lisp - (dolist (k '([mouse-3] - [down-mouse-3] - [drag-mouse-3] - [double-mouse-3] - [mouse-4] - [down-mouse-4] - [drag-mouse-4] - [double-mouse-4] - [triple-mouse-4] - [mouse-5] - [down-mouse-5] - [drag-mouse-5] - [double-mouse-5] - [triple-mouse-5])) - (global-unset-key k)) - #+end_src -*** X clipboard - #+BEGIN_SRC emacs-lisp - (setq select-enable-clipboard t - select-enable-primary t - selection-timeout 100) - #+END_SRC -*** xmobar - #+begin_src emacs-lisp - (defun jao-xmobar-kill () - (interactive) - (shell-command "killall xmobar-exwm")) - - (defun jao-xmobar-restart () - (interactive) - (jao-xmobar-kill) - (start-process "" nil "xmobar-exwm" "-d")) - - #+end_src -* Mode line and minibuffer -*** Time display - #+begin_src emacs-lisp - (setq display-time-world-list - '(("Europe/Paris" "Barcelona") - ("America/Los_Angeles" "Los Angeles") - ("America/New_York" "New York") - ("Europe/London" "London") - ("Asia/Calcutta" "Bangalore") - ("Asia/Tokyo" "Tokyo"))) - - (defun jao-time--pdt-hour () - (jao-time-at-zone "%H" "America/Los_Angeles")) - - (defun jao-time--chicago-hour () - (jao-time-at-zone "%H" "America/Chicago")) - - (defun jao-time-at-zone (format zone) - (set-time-zone-rule zone) - (prog1 (format-time-string format) - (set-time-zone-rule nil))) - - (defun jao-time-echo-la-time () - (interactive) - (message (jao-time-at-zone "LA %H:%M" "America/Los_Angeles"))) - - (defun jao-time-echo-times () - (interactive) - (let ((msg (format "%s (%s)" - (format-time-string "%a, %e %B - %H:%M") - (jao-time-at-zone "%H:%M" "America/Los_Angeles")))) - (jao-notify msg "" (jao-data-file "clock-world-icon.png")))) - - (defun jao-time-to-epoch (&optional s) - "Transform a time string to an epoch integer in milliseconds." - (interactive) - (let ((s (or s (read-string "Time string: " (thing-at-point 'string))))) - (message "%s = %s" - s - (round (* 1000 (time-to-seconds (parse-time-string s))))))) - - (defun jao-epoch-to-time (&optional v) - "Transform an epoch, given in milliseconds, to a time string." - (interactive) - (let ((v (or v (read-number "Milliseconds: " (thing-at-point 'number))))) - (message "%s = %s" v - (format-time-string "%Y-%m-%d %H:%M:%S" - (seconds-to-time (/ v 1000.0)))))) - - (setq display-time-day-and-date nil - display-time-24hr-format nil - display-time-default-load-average nil - display-time-format " %a %e %H:%M") - - #+end_src -*** Minibuffer - #+begin_src emacs-lisp - (defvar jao-modeline-in-minibuffer (and window-system t)) - - (use-package jao-minibuffer - :init - (if (jao-colors-scheme-dark-p) - (setq jao-minibuffer-active-buffer-line-color "azure4" - jao-minibuffer-inactive-buffer-line-color "grey25") - (setq jao-minibuffer-active-buffer-line-color "burlywood3" - jao-minibuffer-inactive-buffer-line-color "grey65")) - :commands (jao-minibuffer-add-variable - jao-minibuffer-refresh - jao-minibuffer-mode)) - - (use-package jao-mode-line - :commands (jao-mode-line-add-to-minibuffer - jao-mode-line-remove-from-minibuffer)) - - (setq enable-recursive-minibuffers t) - (require 'mb-depth) - (minibuffer-depth-indicate-mode 1) - (require 'minibuf-eldef) - (setq minibuffer-eldef-shorten-default t) - (minibuffer-electric-default-mode 1) - - (jao-minibuffer-mode 1) - - (when jao-modeline-in-minibuffer - (add-hook 'display-time-hook #'jao-minibuffer-refresh) - (add-hook 'after-init-hook - (lambda () (jao-mode-line-add-to-minibuffer 90)))) - #+end_src -*** Mode line format - #+begin_src emacs-lisp - (setq line-number-display-limit-width 250) - (setq mode-line-position-column-format '(" %c") - mode-line-position-line-format '(" %l,%c")) - (setq mode-line-percent-position - '(" %l" (:eval (format "/%d" (line-number-at-pos (point-max)))))) - (line-number-mode -1) - (column-number-mode 1) - #+end_src -*** Mode line toggle - #+begin_src emacs-lisp - (use-package jao-mode-line - :init - (when (and window-system (not jao-modeline-in-minibuffer)) - (add-to-list 'after-make-frame-functions #'jao-mode-line-hide-inactive) - (add-hook 'after-init-hook #'jao-toggle-inactive-mode-line)) - :demand t - :bind (("<home>" . jao-mode-line-toggle-inactive) - ("<end>" . jao-mode-line-toggle) - ("<insert>" . jao-mode-line-echo))) - #+end_src -*** Diminish - #+BEGIN_SRC emacs-lisp - (use-package diminish :ensure t) - (when (require 'use-package-diminish nil 'noerror) - (eval-after-load "simple" '(diminish 'auto-fill-function " §")) - (eval-after-load "autorevert" '(diminish 'auto-revert-mode ""))) - #+END_SRC -*** Battery - #+begin_src emacs-lisp - (use-package battery - :init (setq battery-load-low 15 - battery-load-critical 8 - battery-mode-line-limit 40 - battery-echo-area-format - "%L %r %B (%p%% load, remaining time %t)" - battery-mode-line-format " %b%p ")) ;; " 🔋%b%p " - (display-battery-mode 1) - (with-eval-after-load "jao-minibuffer" - (unless jao-modeline-in-minibuffer - (jao-minibuffer-add-variable 'battery-mode-line-string 80))) - #+end_src -* Notifications -*** alert - #+BEGIN_SRC emacs-lisp - (use-package alert - :ensure t - :init - (setq alert-default-style 'message ;; 'libnotify - alert-hide-all-notifications nil)) - #+END_SRC -*** jao-notify - #+begin_src emacs-lisp - (require 'jao-notify) - #+end_src -*** tracking - #+begin_src emacs-lisp - (use-package tracking - :demand t - :init (setq tracking-position 'before-modes - tracking-frame-behavior nil - tracking-most-recent-first nil - tracking-max-mode-line-entries 10 - tracking-sort-faces-first t - tracking-shorten-modes '()) - :config - (setq erc-track-enable-keybindings nil) - - (defun jao-tracking-next-buffer () - (interactive) - (tracking-next-buffer) - (jao-tracking-update-minibuffer)) - - :bind (("C-c C-SPC" . jao-tracking-next-buffer))) - - (use-package jao-tracking - :demand t - :init (setq jao-tracking-bkg - (if (jao-colors-scheme-dark-p) "grey20" "grey93"))) - #+end_src -*** tmr - #+begin_src emacs-lisp - (use-package tmr - :ensure t - :init - (setq tmr-sound-file "/usr/share/sounds/freedesktop/stereo/message.oga" - tmr-descriptions-list '("tea is ready"))) - #+end_src -* Calendar, diary, weather -*** Diary - #+BEGIN_SRC emacs-lisp - (setq diary-file (expand-file-name "diary" jao-org-dir) - diary-display-function 'diary-fancy-display - diary-mail-addr "jao@localhost" - diary-comment-start ";;" - diary-comment-end "") - - (add-hook 'diary-list-entries-hook 'diary-sort-entries t) - #+END_SRC -*** Calendar - #+begin_src emacs-lisp - (setq appt-display-format nil) - (appt-activate 1) - (setq calendar-latitude 55.9533 - calendar-longitude -3.1883 - calendar-location-name "Edinburgh, Scotland" - calendar-mark-diary-entries-flag t - calendar-date-echo-text '(format "ISO date: %s" - (calendar-iso-date-string - (list month day year)))) - - (setq calendar-holidays - '((holiday-fixed 1 1 "New Year's Day") - (holiday-fixed 4 1 "April Fools' Day") - (holiday-float 5 0 2 "Mother's Day") - (holiday-fixed 3 19 "Father's Day") - (holiday-float 11 4 4 "Thanksgiving") - (holiday-fixed 12 25 "Christmas") - (holiday-chinese-new-year) - (solar-equinoxes-solstices) - (holiday-sexp calendar-daylight-savings-starts - (format "Daylight Saving Time Begins %s" - (solar-time-string - (/ calendar-daylight-savings-starts-time - (float 60)) - calendar-standard-time-zone-name))) - (holiday-sexp calendar-daylight-savings-ends - (format "Daylight Saving Time Ends %s" - (solar-time-string - (/ calendar-daylight-savings-ends-time - (float 60)) - calendar-daylight-time-zone-name))))) - - (add-to-list 'display-buffer-alist - `(,(regexp-quote diary-fancy-buffer) - (display-buffer-at-bottom) - (window-parameters (mode-line-format . none)) - (window-height . fit-window-to-buffer))) - - (defun jao-diary--select () - (switch-to-buffer diary-fancy-buffer)) - - (add-hook 'diary-fancy-display-mode-hook #'jao-diary--select) - (setq org-calendar-insert-diary-entry-key nil - org-agenda-diary-file 'diary-file) - - #+end_src -*** Weather -***** winttr - #+begin_src emacs-lisp - (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 "clear;curl wttr.in\n")) - (jao-exec-in-term "curl wttr.in" "*wttr*")))) - (global-set-key (kbd "<f5>") #'jao-weather) - #+end_src -*** Timers - #+BEGIN_SRC emacs-lisp - (put 'list-timers 'disabled nil) - #+END_SRC -* Files, dired and scratch buffer -*** so-long - #+begin_src emacs-lisp - (setq large-file-warning-threshold (* 200 1024 1024)) - - (use-package so-long - :ensure t - :diminish) - (global-so-long-mode 1) - #+end_src -*** Persistent scratch - #+BEGIN_SRC emacs-lisp - (use-package persistent-scratch - :ensure t - :config (persistent-scratch-setup-default)) - #+END_SRC -*** Automatically uncompress - #+BEGIN_SRC emacs-lisp - (require 'jka-compr) - (auto-compression-mode 1) - #+END_SRC -*** wgrep - #+begin_src emacs-lisp - (use-package wgrep :ensure t) - (require 'wgrep) - #+end_src -*** dired - - [[https://www.masteringemacs.org/article/working-multiple-files-dired][Working with multiple files in dired - Mastering Emacs]] - #+begin_src emacs-lisp - (use-package dired - :init - (setq dired-recursive-deletes 'top - dired-recursive-copies 'top - dired-listing-switches "-alhF --group-directories-first" - ls-lisp-dirs-first t - dired-dwim-target t - dired-kill-when-opening-new-dired-buffer t - dired-mouse-drag-files t - wdired-create-parent-directories t) - - (put 'dired-find-alternate-file 'disabled nil) - :hook (dired-mode . turn-on-gnus-dired-mode) - :bind (:map dired-mode-map - ("C-c C-r" . wdired-change-to-wdired-mode) - ("C-M-m" . gnus-dired-attach))) - - (use-package dired-x :demand t) - - (use-package find-dired - :init (setq find-ls-option '("-print0 | xargs -0 ls -ld" . "-ld")) - :bind ("C-c D" . find-name-dired)) - - (use-package dired-git-info - :ensure t - :bind (:map dired-mode-map (")" . dired-git-info-mode))) - - #+end_src -* General editing -*** Executable scripts - #+begin_src emacs-lisp - (add-hook 'after-save-hook - 'executable-make-buffer-file-executable-if-script-p) - #+end_src -*** Long lines - [[https://200ok.ch/posts/2020-09-29_comprehensive_guide_on_handling_long_lines_in_emacs.html][Comprehensive guide on handling long lines in Emacs - 200ok]] - #+begin_src emacs-lisp - (when (version<= "27.1" emacs-version) - (setq bidi-inhibit-bpa t)) - #+end_src -*** Spaces, tabs, kill - #+begin_src emacs-lisp - (setq kill-whole-line t) - (setq-default indent-tabs-mode nil) - (setq indent-tabs-width 4) - (setq-default default-tab-width 8) - (setq tab-always-indent t) - (setq kill-read-only-ok t) - (setq view-read-only nil) - #+end_src -*** Whitespace and filling column - #+begin_src emacs-lisp - (add-hook 'write-file-functions 'delete-trailing-whitespace) - (setq-default indicate-empty-lines nil) - (setq fill-column 78) - (setq comment-auto-fill-only-comments nil) - - (use-package whitespace - :init - (setq whitespace-style '(face tabs trailing ;; lines-tail - empty missing-newline-at-eof) - whitespace-line-column 80) - :hook (prog-mode . whitespace-mode) - :diminish) - - (use-package display-fill-column-indicator - :init (setq-default display-fill-column-indicator-column 80) - :hook (prog-mode . display-fill-column-indicator-mode)) - - #+end_src -*** Visible mode - #+begin_src emacs-lisp - (use-package visible-mode - :bind (("s-v" . visible-mode))) - #+end_src -*** Changes - #+begin_src emacs-lisp - (use-package goto-chg - :ensure t - :bind (("C-." . goto-last-change) - ("C-c ." . goto-last-change) - ("C-c ," . goto-last-change-reverse))) - #+end_src -*** Eval-and-replace - #+BEGIN_SRC emacs-lisp - (defun fc-eval-and-replace () - "Replace the preceding sexp with its value." - (interactive) - (backward-kill-sexp) - (condition-case nil - (prin1 (eval (read (current-kill 0))) - (current-buffer)) - (error (message "Invalid expression") - (insert (current-kill 0))))) - - (global-set-key "\C-ce" 'fc-eval-and-replace) - #+END_SRC -*** Skeletons and autoinsert - #+begin_src emacs-lisp - (use-package autoinsert - :config - (setq auto-insert-directory "~/.emacs.d/autoinsert/" - auto-insert t - auto-insert-query t) - (setf (alist-get 'html-mode auto-insert-alist nil t) nil)) - (add-hook 'find-file-hooks #'auto-insert) - - (use-package jao-skel - :demand t - :config - (require 'jao-skel-geiser) - (require 'jao-skel-lisp) - (require 'jao-skel-haskell) - (require 'jao-skel-latex)) - #+end_src -*** Undo - f to go forward - b to go backward - - n to go to the node below when you at a branching point - p to go to the node above - - a to go back to the last branching point - e to go forward to the end/tip of the branch - - #+begin_src emacs-lisp - (use-package vundo - :ensure t - :config - (set-face-attribute 'vundo-default nil :family "Symbola") - (setq vundo-glyph-alist vundo-unicode-symbols) - :bind (("C-?" . vundo))) - - #+end_src -*** Completion - #+begin_src emacs-lisp - (jao-load-org "completion") - #+end_src -* Buffers -*** cursor and mark - #+begin_src emacs-lisp - (transient-mark-mode -1) - (blink-cursor-mode -1) - (setq cursor-in-non-selected-windows nil) - #+end_src -*** uniquifiy - #+begin_src emacs-lisp - (require 'uniquify) - (setq uniquify-buffer-name-style 'forward - uniquify-trailing-separator-p t) - #+end_src -*** autosave - #+begin_src emacs-lisp - (setq auto-save-list-file-prefix "~/.emacs.d/auto-save-list/.saves-" - auto-save-no-message t - kill-buffer-delete-auto-save-files t) - - (setq lock-file-name-transforms - '(("\\`/.*/\\([^/]+\\)\\'" "/tmp/emacs-lock/\\1" t))) - #+end_src -*** autorevert - #+BEGIN_SRC emacs-lisp - (setq auto-revert-check-vc-info nil) - (setq auto-revert-verbose nil) - (setq auto-revert-avoid-polling t) - (setq auto-revert-mode-text "") - (require 'autorevert) - (global-auto-revert-mode 1) - #+END_SRC -*** attached buffers - #+begin_src emacs-lisp - (defun jao-display-buffer-below-selected (buffer alist) - (delete-other-windows-vertically) - (display-buffer-below-selected buffer alist)) - - (defun jao-attached-buffer-entry (name-rx height) - `(,name-rx (display-buffer-reuse-window - jao-display-buffer-below-selected) - (window-height . ,(or height 25)))) - - (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)) - - (defun jao-define-attached-buffer (name-rx &optional height) - (add-to-list 'display-buffer-alist - (jao-attached-buffer-entry name-rx height))) - - #+end_src -*** images - #+begin_src emacs-lisp - (setq image-use-external-converter t) - (setq widget-image-enable nil) - #+end_src -*** same mode - #+begin_src emacs-lisp - (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) (pop-to-buffer buff)))) - (global-set-key (kbd "C-c C-b") #'jao-buffer-same-mode) - #+end_src -*** projects - #+begin_src emacs-lisp - (use-package project - :bind (("C-x C-p" . project-prefix-map))) - #+end_src -*** buffer quit function (the triple ESC) - #+begin_src emacs-lisp - (setq buffer-quit-function (lambda () t)) - #+end_src -*** pulsar - #+begin_src emacs-lisp - (use-package pulsar - :ensure t - :diminish - :custom ((pulsar-pulse-functions - '(ace-window - backward-page - delete-other-windows - delete-window - forward-page - jao-prev-window - move-to-window-line-top-bottom - org-backward-heading-same-level - org-forward-heading-same-level - org-next-visible-heading - org-previous-visible-heading - other-window - outline-backward-same-level - outline-forward-same-level - outline-next-visible-heading - outline-previous-visible-heading - outline-up-heading - recenter-top-bottom - reposition-window - scroll-down-command - scroll-up-command)) - (pulsar-pulse t) - (pulsar-delay 0.1) - (pulsar-iterations 10) - (pulsar-face 'pulsar-yellow) - (pulsar-highlight-face 'pulsar-face)) - :hook ((jao-afio-switch . pulsar-pulse-line))) - - (pulsar-global-mode) - - #+end_src -* Windows -*** scrolling - #+begin_src emacs-lisp - (setq scroll-preserve-screen-position 'always - scroll-conservatively most-positive-fixnum - scroll-margin 4 - scroll-step 2 - redisplay-skip-fontification-on-input t) - #+end_src -*** splitting and switch - #+begin_src emacs-lisp - (setq split-height-threshold 80 - split-width-threshold 144 - display-buffer-avoid-small-windows 20) - - (setq switch-to-buffer-preserve-window-point nil - switch-to-buffer-obey-display-actions t - switch-to-prev-buffer-skip 'this) ;; don't switch to a - ;; buffer already visible in - ;; this frame - - (global-set-key (kbd "C-x _") #'delete-other-windows-vertically) - #+end_src -*** first window - #+begin_src emacs-lisp - (defvar jao-first-window--from nil) - - (defun jao-first-window () - "Go to previous windows in frame, remembering where we were." - (interactive) - (let ((cb (current-buffer))) - (if (eq (get-buffer-window cb) (select-window (frame-first-window))) - (when jao-first-window--from (pop-to-buffer jao-first-window--from)) - (setq jao-first-window--from cb)))) - - (defun jao-prev-window () - "Go to previous window." - (interactive) - (other-window -1)) - - (global-set-key (kbd "C-x p") #'jao-prev-window) - (global-set-key (kbd "s-a") #'jao-first-window) - (global-set-key (kbd "M-a") #'jao-first-window) - - #+end_src -*** ace window - #+begin_src emacs-lisp - (use-package ace-window - :ensure t - :demand t - :init (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) - aw-char-position 'top-left - aw-ignore-current nil - aw-dispatch-when-more-than 2 - aw-leading-char-style 'path - aw-display-mode-overlay t - aw-scope 'frame) - :config - - (defun jao-ace-consult-buffer-other-window (w) - (interactive) - (aw-switch-to-window w) - (consult-buffer)) - - (setf (alist-get ?b aw-dispatch-alist) - '(jao-ace-consult-buffer-other-window "Consult buffer")) - - (setf (alist-get ?B aw-dispatch-alist) - (alist-get ?u aw-dispatch-alist)) - - - :bind (("M-o" . ace-window) - ("M-O" . ace-swap-window) - ("C-x 4 t" . ace-swap-window))) - - #+end_src -*** window navigation (custom) - #+begin_src emacs-lisp - (defun jao-nth-window (n) - (if (zerop n) - 'jao-first-window - `(lambda () - (interactive) - (select-window (frame-first-window)) - (dotimes (x ,n) (other-window 1))))) - - (defun jao-prev-window () - "Go to previous window" - (interactive) - (other-window -1)) - - (defun jao-next-window () - "Go to previous window" - (interactive) - ;; next-window-any-frame - (other-window 1)) - - (global-set-key (kbd "C-x p") 'jao-prev-window) - (global-set-key (kbd "C-x o") 'other-window) - (mapc (lambda (n) - (global-set-key (format "\C-c%s" (1+ n)) (jao-nth-window n))) - '(0 1 2 3 4 5 6 7 8)) - - ;; transposing windows - (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 (plusp arg) (1- arg) (1+ arg)))))) - - (define-key ctl-x-4-map (kbd "t") 'transpose-windows) - #+end_src - - #+RESULTS: - : transpose-windows -*** winner mode - #+begin_src emacs-lisp - (winner-mode 1) - #+end_src -* Frames -*** Frame geometry - #+begin_src emacs-lisp - (setq frame-resize-pixelwise nil) - ;;; modeline, toolbars and co. - (modify-all-frames-parameters - `((horizontal-scroll-bars . nil) - (vertical-scroll-bars . nil) - (scroll-bar-width . 11) - (menu-bar . nil))) - #+end_src -*** Frame layout, title, etc. - #+begin_src emacs-lisp - (setq frame-title-format '("%b")) - (use-package fringe) - (fringe-mode) - - (menu-bar-mode -1) - - ;; (setting it to nil avoids mouse wrapping after other-frame) - (setq focus-follows-mouse t) - - (use-package scroll-bar) - (set-scroll-bar-mode nil) - (use-package tool-bar) - (tool-bar-mode -1) - - (defun jao-trisect (&optional force) - (interactive) - (let ((fw (frame-width))) - (delete-other-windows) - (cond ((or force (>= fw 240)) - (let ((w (- (/ fw 3)))) - (delete-other-windows) - (split-window-horizontally w) - (split-window-horizontally w) - (balance-windows))) - ((> fw 162) - (split-window-horizontally) - (switch-to-buffer (other-buffer)))))) - - (defun jao-bisect () - (interactive) - (jao-trisect t) - (next-window) - (delete-window)) - #+end_src -*** afio - #+begin_src emacs-lisp - (use-package jao-afio) - - (defun jao-xmonad-goto-1 () - (shell-command "sendCommand 1")) - - (defun jao-afio--goto-scratch-1 () - (interactive) - (jao-afio-goto-scratch t)) - - (jao-afio-setup 'jao-afio--goto-scratch-1 t) - - (defun jao-current--frame-id () - (propertize (if (and (jao-exwm-enabled-p) - (not (bound-and-true-p jao-exwm--use-afio))) - (format "F%s" exwm-workspace-current-index) - (format "%s" (jao-afio-current-no))) - 'face 'font-lock-warning-face)) - - (add-hook 'jao-afio-switch-hook #'tracking-remove-visible-buffers) - (jao-minibuffer-add-variable '(jao-current--frame-id) 100) - - (defun jao-afio--set-mode-line () - (when (and window-system (fboundp 'jao-mode-line-hide-inactive)) - (if (string= "Docs" (jao-afio-current-frame)) - (jao-mode-line-show-inactive nil) - (jao-mode-line-hide-inactive nil)))) - - (unless jao-modeline-in-minibuffer - (add-hook 'jao-afio-switch-hook #'jao-afio--set-mode-line)) - #+end_src -* Writing and writing modes -*** Copyright notices - #+begin_src emacs-lisp - (setq copyright-year-ranges t) - (add-hook 'write-file-functions 'copyright-update) - #+end_src -*** Indent on yank - #+begin_src emacs-lisp - ;;; indent on yank - (defvar jao-auto-indent-modes - '(emacs-lisp-mode ;; clojure-mode - scheme-mode objc-mode - tuareg-mode c-mode c++-mode - tcl-mode sql-mode - perl-mode cperl-mode - java-mode jde-mode - LaTeX-mode TeX-mode)) - - (defadvice yank (after indent-region activate) - (if (member major-mode jao-auto-indent-modes) - (indent-region (region-beginning) (region-end) nil))) - #+end_src -*** Org mode - #+begin_src emacs-lisp - (jao-load-org "org") - #+end_src -*** Blog - #+begin_src emacs-lisp - (jao-load-org "blog") - #+end_src -*** Text-ish mode settings - #+begin_src emacs-lisp - ;;; SENTENCES separated by just one space - (setq sentence-end "[.?!][]\"')]*\\($\\|\t\\| \\)[ \t\n]*") - (setq sentence-end-double-space t) - ;;; copy rectangle - (defun kill-rectangle-save (start end) - "Save the region-rectangle as the last killed one." - (interactive "r") - (require 'rect) ; Make sure killed-rectangle is defvar'ed. - (setq killed-rectangle (extract-rectangle start end)) - (message "Rectangle saved")) - - ;; text mode, autoinserts and write hooks - ;;; misc - (setq default-major-mode 'text-mode) - - (add-hook 'text-mode-hook 'turn-on-auto-fill) - #+end_src -*** Dictionaries - #+begin_src emacs-lisp - (defun jao-word-definition-lookup () - "Look up the word under cursor in a browser." - (interactive) - (require 'thingatpt) - (browse-url - (concat "http://www.wordnik.com/words/" - ;; "http://www.answers.com/main/ntquery?s=" - (thing-at-point 'word)))) - - (use-package dictionary - :init (setq dictionary-use-single-buffer t - dictionary-server "localhost") - :commands (dictionary-search - dictionary-match-words - dictionary-lookup-definition - dictionary - dictionary-mouse-popup-matching-words - dictionary-popup-matching-words - dictionary-tooltip-mode - global-dictionary-tooltip-mode) - :bind (("C-c d" . dictionary-search))) - - (setq ispell-personal-dictionary - (expand-file-name "~/.emacs.d/ispell.dict")) - - (use-package wordreference - :ensure t - :init (setq wordreference-target-lang "es" - wordreference-source-lang "en") - :bind (("C-c D" . wordreference-search))) - - #+end_src -*** Markdown - #+BEGIN_SRC emacs-lisp - (use-package markdown-mode - :ensure t) - - (use-package markdown-toc - :ensure t) - - (dolist (ext '("\\.md$" "\\.markdown$")) - (add-to-list 'auto-mode-alist (cons ext 'markdown-mode))) - #+END_SRC -*** TeX and LaTex - #+BEGIN_SRC emacs-lisp - (use-package tex-site - :ensure auctex - :init - (setq TeX-auto-save t) - (setq TeX-parse-self t) - (setq TeX-a4-paper t) - (setq TeX-auto-local ".tex-auto-local") - ;; Preferred view format: dvi, ps, pdf, pdfs - (setq TeX-view-format "pdf") - (setq-default TeX-master "../main") ; nil to ask - (setq TeX-view-program-selection - ;; '((output-dvi "open") - ;; (output-pdf "open") - ;; (output-html "open")) - '(((output-dvi has-no-display-manager) "dvi2tty") - ((output-dvi style-pstricks) "dvips and gv") - (output-dvi "xdvi") - (output-pdf "xdg-open") - (output-html "xdg-open"))) - ;; to make RefTeX faster for large documents, try these: - (setq reftex-enable-partial-scans t) - (setq reftex-save-parse-info t) - (setq reftex-use-multiple-selection-buffers t) - ;; to integrate with AUCTeX - (setq reftex-plug-into-AUCTeX t) - (setq reftex-ref-style-default-list - '("Hyperref" "Varioref" "Fancyref")) - (setq LaTeX-command "latex -shell-escape") - (setq LaTeX-biblatex-use-Biber t) - (setq bibtex-dialect 'biblatex) - :config - (add-hook 'TeX-after-compilation-finished-functions - #'TeX-revert-document-buffer) - (add-hook 'LaTeX-mode-hook 'turn-on-reftex) - ) - -;; (use-package ebib - ;; :ensure t - ;; :config (setq ebib-bibtex-dialect 'biblatex)) - - ;; for M-x biblio-lookup - ;; (use-package biblio :ensure t) - #+END_SRC -* Browsing -*** Variables - #+begin_src emacs-lisp - (defvar jao-browse-doc-use-emacs-p t) - (defvar jao-browse-url-function nil) - (defvar jao-browse-url-external-function nil) - #+end_src -*** URL around point - #+begin_src emacs-lisp - (defun jao-url-around-point (&optional current-url) - (or (and (fboundp 'w3m-anchor) (w3m-anchor)) - (shr-url-at-point nil) - (ffap-url-at-point) - (thing-at-point 'url) - (when current-url - (or (and (fboundp 'w3m-anchor) (w3m-anchor)) - (and (derived-mode-p 'eww-mode) (plist-get eww-data :url)))))) - - (defun jao--url-prompt () - (let* ((def (jao-url-around-point t)) - (prompt (concat "URL" (if def (format " (%s): " def) ": ")))) - (read-string prompt nil nil def))) - #+end_src -*** Downloads using wget - #+BEGIN_SRC emacs-lisp - (defun jao-wget--get-title (filename) - (let ((fn (file-name-base filename))) - (if (string-blank-p fn) - (plist-get eww-data :title) - (subst-char-in-string ?- ? (capitalize fn))))) - - (defun jao-wget (url &optional user pwd) - "Download URL using wget." - (let* ((def (file-name-nondirectory url)) - (pmt (format "Save %s to: " url)) - (read-file-name-function nil) - (dest (expand-file-name - (read-file-name pmt jao-sink-dir nil nil def))) - (title (jao-wget--get-title dest)) - (src-url (jao-url-around-point t)) - (auth (when (and user pwd) - `(,(format "--http-user=%s" user) - ,(format "--http-password=%s" pwd))))) - (switch-to-buffer-other-window (get-buffer-create "*downloads*")) - (erase-buffer) - (kill-new (format "[[doc:%s][%s]] (from [[%s][here]])" - (file-name-nondirectory dest) - (read-string "Title: " title) - (or src-url (file-name-directory url)))) - (apply 'make-term `("downloads" "wget" nil ,@auth "-O" ,dest ,url)))) - - (defun jao-download (url &optional pws) - "Download URL using wget" - (interactive (list (jao--url-prompt))) - (when url - (let ((usr (and pws (read-string "Login name: "))) - (pwd (and pws (read-passwd "Password: ")))) - (jao-wget url usr pwd)))) - - (with-eval-after-load "embark" - (define-key embark-url-map (kbd "d") #'jao-download)) - - #+END_SRC -*** Video - #+BEGIN_SRC emacs-lisp - (defvar jao-video--url-rx - (format "^https?://\\(?:www\\.\\)?%s/.+" - (regexp-opt '("youtu.be" - "youtube.com" - "blip.tv" - "vimeo.com" - "infoq.com") - t))) - - (defvar jao-video--ext-rx - (format "^https?://.+/.+\\.%s" (regexp-opt '("mp3" "webm" "mp4")))) - - (defun jao-video--url-p (url) - (or (string-match-p jao-video--url-rx url) - (string-match-p jao-video--ext-rx url))) - - (defun jao--remote-run (url prg) - (let ((args (format "%s %s" prg (shell-quote-argument url)))) - (start-process-shell-command prg nil args))) - - (defun jao--mpv (url &rest args) (jao--remote-run url "mpv")) - (defun jao--vlc (url &rest args) (jao--remote-run url "vlc")) - - (defvar jao--video-player 'jao--mpv) - - (defun jao-view-video (url) - "Tries to stream a video from the current or given URL" - (interactive (list (jao--url-prompt))) - (when url (funcall jao--video-player url))) - - (defun jao-maybe-view-video (url &rest _ignored) - (interactive) - (if (y-or-n-p "View video (y) or web page (n)? ") - (jao-view-video url) - (funcall jao-browse-url-function url))) - - #+END_SRC -*** Web browsers - #+begin_src emacs-lisp - (defun jao-www--buffer-p (b) - (with-current-buffer b - (or (derived-mode-p 'w3m-mode 'eww-mode) - (and (boundp 'exwm-class-name) - (member (buffer-local-value 'exwm-class-name b) - '("vlc" "mpv")))))) - (jao-load-org "eww") - #+end_src -*** Browse URL - #+begin_src emacs-lisp - (require 'browse-url) - - (setq browse-url-generic-program "~/bin/firehog") - - (defun jao-browse-with-external-browser (&rest url) - "Browse with external hogging" - (interactive "s") - (let ((url (or (car url) (jao-url-around-point)))) - (if (not url) - (message "No URL at point") - (when (and (jao-exwm-enabled-p) (fboundp 'jao-exwm-firefox)) - (jao-exwm-firefox)) - (when (and jao-sway-enabled (fboundp 'jao-sway-firefox)) - (jao-sway-firefox)) - (browse-url-generic url)))) - (setq jao-browse-url-external-function 'jao-browse-with-external-browser) - - (defun jao--fln (url) - (shell-quote-argument - (if (string-match "^[^:]*:/*?\\(/?[^/].*\\)" url) - (match-string-no-properties 1 url) - url))) - - (defun jao--browse-doc (url search &optional no-add) - (let* ((url (substring-no-properties url)) - (file (jao--fln url))) - (when file - (unless (file-exists-p file) - (error "File %s does not exist" file)) - (jao-open-doc file)))) - - (defun jao--make-file-rx (exts) - (format "file:/?/?.+\\.%s$" (regexp-opt exts))) - - (defvar jao--see-exts - (jao--make-file-rx '("jpg" "jpeg" "png" "mov" "wmv" "avi" "mp4"))) - - (defvar jao--doc-exts - (jao--make-file-rx '("ps" "ps.gz" "pdf" "dvi" "djvu" "chm"))) - - (defvar jao-browse-url-wget-exts - '("ps" "pdf" "dvi" "djvu" "zip" "gz" "tgz" "mp4" "mp3" "flv")) - - (defvar jao-browse-external-domains - '("github.com" "gitlab.com" "slack.com" "meet.google.com" - "twitter.com" "t.com" "linkedin.com" "bigml.com")) - - (defvar jao-browse--external-regexp - (format "https?://.*%s\\(/.*\\)?" - (regexp-opt jao-browse-external-domains))) - - (defun jao-wget--regexp () - (concat "^http[s]?://.+\\(\\." - (mapconcat 'identity jao-browse-url-wget-exts "\\|\\.") - "\\)\\'")) - - (defun jao--see (url &rest _r) - (start-process-shell-command "see" nil (format "see %s" (jao--fln url)))) - - (defun jao--find-file-other-window (url &rest _) - (find-file-other-window (jao--fln url))) - - (use-package elpher :ensure t) - - (defun jao-elpher--browse (url &rest _) (elpher-go url)) - - (defvar jao-browse--sound-rx - (format "^https?://.*/.*\\.%s" (regexp-opt '("mp4" "mp3" "flv")))) - - (defun jao-browse-add-url-to-mpc (url &rest _) - "Add the given URL to mpc's playing list, or just play it." - (let ((p (yes-or-no-p (format "Play %s right now?" url)))) - (when p (jao-mpc-clear)) - (jao-mpc-add-url url) - (if p (jao-mpc-play) (message "%s added to mpc queue" url)))) - - (defun jao-browse-url-browse (&rest args) - (apply jao-browse-url-function args)) - - (setq browse-url-handlers - `(("^\\(gemini\\|gopher\\)://.*" . jao-elpher--browse) - (,jao--doc-exts . jao--browse-doc) - (,jao--see-exts . jao--see) - ("^file://?.+\\.html?$" . ,jao-browse-url-function) - ("^file://?" . jao--find-file-other-window) - (,jao-browse--external-regexp . ,jao-browse-url-external-function) - ("^https?://.*\\.gotomeeting\\.com\\.*" . browse-url-chrome) - (,jao-browse--sound-rx . jao-browse-add-url-to-mpc) - (,(jao-wget--regexp) . jao-download) - (jao-video--url-p . jao-maybe-view-video) - ("." . jao-browse-url-browse))) - - (when (< emacs-major-version 28) - (setf (alist-get 'jao-video--url-p browse-url-handlers nil t) nil) - (setq browse-url-browser-function browse-url-handlers)) - - #+end_src -*** Subscribe rss using r2e - #+begin_src emacs-lisp - (autoload 'View-quit "view") - - (defun jao-rss--find-url () - (save-excursion - (when (derived-mode-p 'w3m-mode 'eww-mode) - (if (fboundp 'w3m-view-source) (w3m-view-source) (eww-view-source))) - (goto-char (point-min)) - (when (re-search-forward - "type=\"application/\\(?:atom\\|rss\\)\\+xml\" +" nil t) - (let ((url (save-excursion - (when (re-search-forward - "href=\"\\([^\n\"]+\\)\"" nil t) - (match-string-no-properties 1)))) - (title (when (re-search-forward - "\\(?:title=\"\\([^\n\"]+\\)\" +\\)" nil t) - (match-string-no-properties 1)))) - (cond ((derived-mode-p 'w3m-view-mode) (w3m-view-source)) - ((string-match-p ".*\\*eww-source\\b.*" (buffer-name)) - (View-quit))) - (when url (cons url (or title ""))))))) - - (defun jao-rss2e-append (name url mbox) - (with-current-buffer (find-file-noselect "~/.config/rss2email.cfg") - (goto-char (point-max)) - (insert "[feed." name "]\nurl = " url) - (insert "\nto = " mbox "+" name "@localhost") - (insert "\nmaildir-mailbox = " mbox "\n\n") - (save-buffer))) - - (defun jao-rss--feeds-dirs () - (mapcar (lambda (d) (cadr (split-string d "\\."))) - (directory-files "~/.emacs.d/gnus/Mail/" nil "^feeds"))) - - (defun jao-rss-subscribe (url) - "Subscribe to a given RSS URL. If URL not given, look for it." - (interactive (list (or (jao-url-around-point) - (jao-rss--find-url) - (read-string "Feed URL: ")))) - (let* ((url+title (if (consp url) url (list url))) - (url (car url+title)) - (title (cdr url+title)) - ;; (cats (cons "prog" (jao-notmuch--subtags "feeds"))) - (cats (jao-rss--feeds-dirs))) - (if url - (let ((url (if (string-match "^feed:" url) (substring url 5) url))) - (when (y-or-n-p (format "Subscribe to <%s>? " url)) - (let* ((name (read-string "Feed name: " title)) - (cat (completing-read "Category: " cats nil t)) - (subs (format "r2e add %s '%s' feeds.%s@localhost" - name url cat))) - ;; (jao-rss2e-append name url cat) - (shell-command-to-string subs) - (shell-command (format "r2e run %s" name))))) - (message "No feeds found")))) - #+end_src -* Email - #+begin_src emacs-lisp - (setq jao-afio-mail-function 'notmuch) - ;; (setq jao-afio-mail-function 'gnus) - (jao-load-org "email") - #+end_src -* PDFs and other docs -*** doc-view - #+begin_src emacs-lisp - (use-package doc-view - :init - (setq doc-view-cache-directory "~/.emacs.d/cache/docview" - doc-view-resolution 110 - doc-view-continuous t - doc-view-conversion-refresh-interval 1) - - :bind (:map doc-view-mode-map - ("j" . doc-view-next-line-or-next-page) - ("J" . doc-view-scroll-up-or-next-page) - ("k" . doc-view-previous-line-or-previous-page) - ("K" . doc-view-scroll-down-or-previous-page))) - - (use-package jao-doc-view - :bind (:map doc-view-mode-map - ("b" . jao-doc-view-back) - ("B" . jao-doc-view-forward) - ("S" . jao-doc-view-save-session) - ("u" . jao-doc-view-visit-url))) - #+end_src -*** pdf-tools - #+begin_src emacs-lisp - (use-package pdf-tools - :ensure t - :demand t - :init - (add-hook 'after-init-hook - (lambda () - (setq pdf-view-midnight-colors - (cons (frame-parameter nil 'foreground-color) - (frame-parameter nil 'background-color))))) - - :config (pdf-tools-install) - - :diminish ((pdf-view-midnight-minor-mode . "")) - - :bind (:map pdf-view-mode-map - (("C-c C-d" . pdf-view-midnight-minor-mode) - ("j" . pdf-view-next-line-or-next-page) - ("J" . pdf-view-scroll-up-or-next-page) - ("k" . pdf-view-previous-line-or-previous-page) - ("K" . pdf-view-scroll-down-or-previous-page)))) - - #+end_src -*** zathura - #+begin_src emacs-lisp - (defun jao-zathura-file-info (title) - (when (string-match "\\(.+\\) \\[\\(.+\\) (\\([0-9]+\\)/\\([0-9]+\\))\\]" - title) - (list (expand-file-name (match-string 1 title)) - (string-to-number (match-string 3 title)) - (string-to-number (match-string 4 title)) - (match-string 2 title)))) - - (defun jao-zathura-goto-org (&optional title) - (when-let* ((title (or title (jao-shell-string "xdotool" - "getactivewindow" - "getwindowname"))) - (info (jao-zathura-file-info title)) - (file (jao-org-pdf-to-org-file (car info))) - (page (cadr info)) - (pageno (or (car (last info)) page))) - (jao-afio--goto-docs) - (let* ((exists (file-exists-p file)) - (fn (file-name-nondirectory file)) - (lnk (format "[[doc:%s::%d][Page %s]]" fn page pageno))) - (find-file file) - (unless exists (jao-org-insert-doc-skeleton)) - (if (or (not exists) (y-or-n-p "Insert link?")) - (insert lnk "\n") - (kill-new lnk) - (message "Link to %s (%s) killed" file page))))) - - (defun jao-zathura-open (file page) - (let ((id (jao-shell-string (format "xdotool search --name %s" - (file-name-nondirectory file))))) - (if (string-blank-p id) - (jao-shell-exec (format "zathura %s -P %s" file (or page 1))) - (let* ((page (if page (format " && xdotool type %dg" page) "")) - (cmd (format "xdotool windowactivate %s%s" id page))) - (jao-shell-string cmd))))) - - #+end_src -*** open pdfs - #+begin_src emacs-lisp - (use-package saveplace-pdf-view - :ensure t - :demand t - :after doc-view) - - (setq jao-open-doc-fun 'jao-find-or-open) - (setq jao-org-open-pdf-fun 'jao-find-or-open) - - (defun jao-find-or-open (file &optional page height) - (if (and jao-browse-doc-use-emacs-p window-system) - (let* ((buffs (buffer-list)) - (b (catch 'done - (while buffs - (when (string-equal (buffer-file-name (car buffs)) file) - (throw 'done (car buffs))) - (setq buffs (cdr buffs)))))) - (jao-afio--goto-docs) - (if b (pop-to-buffer b) (find-file file)) - (when page (jao-doc-view-goto-page page height))) - (jao-zathura-open file page))) - - (defun jao-open-doc (&optional file page height) - (interactive) - (when-let (file (or file - (read-file-name "Document: " - (concat jao-org-dir "/doc/")))) - (funcall jao-open-doc-fun file page height))) - - (defun jao-select-pdf () - (interactive) - (jao-buffer-same-mode '(pdf-view-mode doc-view-mode) - #'jao-afio--goto-docs)) - #+end_src -*** epub - #+begin_src emacs-lisp - (use-package nov - :ensure t - :after doc-view - :init (setq nov-variable-pitch t - nov-text-width 80) - :config (add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode))) - - #+end_src -*** transient - #+begin_src emacs-lisp - (defun jao-org-pdf-goto-org-linking () - (interactive) - (jao-org-pdf-goto-org 4)) - - (jao-transient-major-mode doc-view - ["Notes" - ("o" "notes file" jao-org-pdf-goto-org) - ("O" "notes file, linking" jao-org-pdf-goto-org-linking)] - ["Navigation" - ("b" "back jump" jao-doc-view-back) - ("B" "forward jump" jao-doc-view-back) - ("u" "visit URL" jao-doc-view-visit-url)] - ["Slices" - ("cb" "bounding box" doc-view-set-slice-from-bounding-box) - ("cm" "using mouse" doc-view-set-slice-using-mouse)] - ["Session" - ("s" "load session" jao-afio-open-pdf-session) - ("S" "save session" jao-doc-view-save-session) - ("d" "visit cache directory" doc-view-dired-cache)]) - - (with-eval-after-load "pdf-view" - (jao-transient-major-mode pdf-view - ["Notes" - ("o" "notes file" jao-org-pdf-goto-org) - ("O" "notes file, linking" jao-org-pdf-goto-org-linking)] - ["Navigation" - ("b" "back jump" pdf-history-backward) - ("f" "forward jump" pdf-history-forward)] - ["Session" - ("s" "load session" jao-afio-open-pdf-session) - ("S" "save session" jao-doc-view-save-session)])) - - ;; (transient-get-suffix 'jao-transient-pdf-view '(0 -1)) - - #+end_src -* Shells and terms -*** shell modes - #+begin_src emacs-lisp - (setq sh-basic-offset 2) - ;; translates ANSI colors into text-properties, for eshell - (autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t) - (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on) - #+end_src -*** vterm - #+begin_src emacs-lisp - (defvar jao-use-vterm nil) - - (use-package vterm - :ensure t - :demand t - :commands (vterm vterm-mode) - :init (setq vterm-kill-buffer-on-exit t - vterm-copy-exclude-prompt t - jao-use-vterm t) - :config (jao-define-attached-buffer "\\*vterm\\*" 0.5) - :bind (("<f3>" . vterm) - :map vterm-mode-map ("C-c C-c" . vterm-send-C-c))) - - (defun jao-exec-in-vterm (cmd bname) - (if (string-blank-p (or cmd "")) - (vterm) - (let ((vterm-shell cmd) - (vterm-kill-buffer-on-exit t) - (buff (generate-new-buffer bname))) - (switch-to-buffer buff) - (vterm-mode)))) - - #+end_src -*** term - #+begin_src emacs-lisp - (defvar-local jao-term--cmd nil) - - (defun jao-term--find (cmd) - (seq-find (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'term-mode 'vterm-mode) - (string= (or jao-term--cmd "") cmd)))) - (buffer-list))) - - (defun jao-exec-in-term (cmd &optional name) - (if jao-use-vterm - (jao-exec-in-vterm cmd name) - (ansi-term "bash" name) - (set-process-sentinel (get-buffer-process (current-buffer)) - (lambda (process event) - (when (string= event "finished\n") - (kill-buffer (process-buffer process))))) - (term-send-string nil (concat cmd " ; exit\n")))) - - (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)) - (setq-local jao-term--cmd ,cmd))))) - - #+end_src -*** eshell -***** Basic custom - #+begin_src emacs-lisp - (use-package eshell - :init - (setq eshell-directory-name "~/.emacs.d/eshell") - (setq eshell-hist-ignoredups 'erase) - - (defun jao-eshell--outline () - (setq-local outline-regexp eshell-prompt-regexp)) - - :hook (eshell-mode . jao-eshell--outline)) - #+end_src -***** Colors - #+begin_src emacs-lisp - (autoload 'ansi-color-apply "ansi-color") - ;; (add-hook 'eshell-preoutput-filter-functions 'ansi-color-filter-apply) - (add-hook 'eshell-preoutput-filter-functions 'ansi-color-apply) - - (use-package eshell-syntax-highlighting - :after esh-mode - :ensure t - :config - ;; Enable in all Eshell buffers. - (eshell-syntax-highlighting-global-mode +1)) - #+end_src -***** Visual commands - #+begin_src emacs-lisp - (require 'em-term) - ;;; commands using ansi scape seqs - (dolist (c '("editor" "more" "wget" "dict" "vim" "links" "w3m" "guile" - "ssh" "autossh" "zmore" "pager" "aptitude" "su" "htop" "top" - "screen" "whizzml" "iex" "spt")) - (add-to-list 'eshell-visual-commands c)) - - (setq eshell-visual-subcommands '(("git" "log" "diff" "show") - ("sudo" "vim") - ("rebar3" "shell")) - eshell-destroy-buffer-when-process-dies nil - eshell-escape-control-x t) - - (use-package eshell-vterm :ensure t) - - (when jao-use-vterm (eshell-vterm-mode)) - - #+end_src -***** bol - #+begin_src emacs-lisp - (defun jao-eshell-maybe-bol () - (interactive) - (let ((p (point))) - (eshell-bol) - (if (= p (point)) - (beginning-of-line)))) - #+end_src -***** Prompt - #+BEGIN_SRC emacs-lisp - ;; tracking git repos - (defun jao-eshell--git-dirty () - (shell-command-to-string "git diff-index --quiet HEAD -- || echo -n '*'")) - - (use-package git-ps1-mode - :ensure t - :init (setq git-ps1-mode-showupstream "1" - git-ps1-mode-showdirtystate "1")) - - (defun jao-eshell--git-info () - (if (fboundp 'git-ps1-mode-get-current) - (git-ps1-mode-get-current) - (let ((desc (shell-command-to-string "git branch --no-color"))) - (when (string-match "^* \\(\\<.+\\>\\)" desc) - (format "%s%s" (match-string 1 desc) (jao-eshell--git-dirty)))))) - - (defun jao-eshell--git-current-branch (suffix) - (let ((desc (or (jao-eshell--git-info) ""))) - (cond ((and (string-empty-p desc) suffix) (format " (%s)" suffix)) - ((string-empty-p (or suffix "")) (format " (%s)" desc)) - (t (format " (%s %s)" desc suffix))))) - - (defun jao-eshell--virtualenv () - (let ((venv (getenv "VIRTUAL_ENV"))) - (when (and venv (string-match ".*/\\([^/]+\\)/$" venv)) - (match-string-no-properties 1 venv)))) - - (defun jao-eshell-prompt-function () - (let* ((venv (jao-eshell--virtualenv)) - (venv (if venv (format "%s" venv) ""))) - (concat (abbreviate-file-name (eshell/pwd)) - (jao-eshell--git-current-branch venv) - (if (= (user-uid) 0) " # " " $ ")))) - - (setq eshell-prompt-function 'jao-eshell-prompt-function) - #+END_SRC -***** in-term - #+begin_src emacs-lisp - (defun eshell/in-term (prog &rest args) - (switch-to-buffer - (apply #'make-term (format "in-term %s %s" prog args) prog nil args)) - (term-mode) - (term-char-mode)) - #+end_src -***** Dir navigation - #+BEGIN_SRC emacs-lisp - (use-package eshell-up - :ensure t - :config (setq eshell-up-print-parent-dir t)) - - (use-package eshell-autojump :ensure t) - #+END_SRC -***** Completion - #+begin_src emacs-lisp - (defun jao-eshell-completion-capf () - (let* ((b (save-excursion (eshell-bol) (point))) - (c (bash-completion-dynamic-complete-nocomint b (point) t))) - (when (and c (listp c)) - (append c '(:exclusive no))))) - - (defun jao-eshell--set-up-completion () - (setq-local completion-styles '(basic partial-completion) - completion-at-point-functions - '(jao-eshell-completion-capf - pcomplete-completions-at-point t))) - - (use-package bash-completion - :ensure t - :hook (eshell-mode . jao-eshell--set-up-completion)) - #+end_src -***** History - #+BEGIN_SRC emacs-lisp - (setq eshell-history-size 10000) - ;;; Fix eshell history completion to allow !$ - ;; This is done by advising eshell-history-reference to expand !$ - ;; into !!:$ which works... - (defadvice jao-eshell-history-reference (before ben-fix-eshell-history) - "Fixes eshell history to allow !$ as abbreviation for !!:$" - (when (string= (ad-get-arg 0) "!$") (ad-set-arg 0 "!!:$"))) - (ad-activate 'jao-eshell-history-reference) - #+END_SRC - This is needed if we want ! to expand in emacs >= 27 - #+BEGIN_SRC emacs-lisp - (add-hook 'eshell-expand-input-functions #'eshell-expand-history-references) - #+END_SRC -***** Toggle - #+begin_src emacs-lisp - - (use-package jao-eshell-here - :demand t - :config (jao-define-attached-buffer "^\\*eshell" 0.5) - :bind (("<f1>" . jao-eshell-here-toggle) - ("C-<f1>" . jao-eshell-here-toggle-new))) - - #+end_src -***** Workarounds - #+begin_src emacs-lisp - ;; at some point, bash completion started insertig the TAB - ;; after the commands ends - (defun jao-eshell--clean-prompt () - (eshell-bol) - (ignore-errors (kill-line))) - - (add-hook 'eshell-after-prompt-hook 'jao-eshell--clean-prompt) - #+end_src -***** Keybindings - #+begin_src emacs-lisp - (defun jao-eshell--kbds () - (define-key eshell-mode-map "\C-a" 'jao-eshell-maybe-bol) - (define-key eshell-mode-map "\C-ci" 'consult-outline)) - ;; Eshell mode is sillily re-creating its mode map - ;; in every buffer in emacs < 28. - (if (> emacs-major-version 27) - (jao-eshell--kbds) - (add-hook 'eshell-mode-hook #'jao-eshell--kbds)) - #+end_src -* Version control and CI -*** General options - #+begin_src emacs-lisp - (setq vc-follow-symlinks t) - (setq auto-revert-check-vc-info nil) - #+end_src -*** Diff fringe indicators (diff-hl) - #+begin_src emacs-lisp - (use-package diff-hl - :ensure t - :custom ((diff-hl-draw-borders nil) - (diff-hl-side 'right) - (diff-hl-margin-symbols-alist - '((insert . "+") - (delete . "-") - (change . "~") - (unknown . "?") - (ignored . "i")))) - :config - (map-keymap (lambda (_k cmd) - (put cmd 'repeat-map 'diff-hl-command-map)) - diff-hl-command-map) - (add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh) - (when (jao-colors-scheme-dark-p) (diff-hl-margin-mode 1))) - - (global-diff-hl-mode 1) - - #+end_src -*** Git config files: more informative diffs - See [[https://protesilaos.com/codelog/2021-01-26-git-diff-hunk-elisp-org/][Informative diff hunks for Emacs Lisp and Org | Protesilaos Stavrou]] - #+begin_src config :tangle ~/.config/git/attributtes :comments no - *.clj diff=lisp - *.cljc diff=lisp - *.cljs diff=lisp - *.lisp diff=lisp - *.el diff=lisp - *.org diff=org - #+end_src - #+begin_src gitconfig :tangle ~/.config/git/config - [diff "lisp"] - xfuncname = "^(((;;;+ )|\\(|([ \t]+\\(((cl-|el-patch-)?def(un|var|macro|method|custom)|gb/))).*)$" - [diff "org"] - xfuncname = "^(\\*+ +.*)$" - #+end_src -*** Magit and forge - #+begin_src emacs-lisp - (use-package magit - :ensure t - :commands magit-status - :init - (setq magit-status-initial-section nil - magit-define-global-key-bindings nil - magit-completing-read-function 'magit-builtin-completing-read - magit-display-buffer-function - 'magit-display-buffer-fullcolumn-most-v1 - magit-delete-by-moving-to-trash nil - magit-last-seen-setup-instructions "1.4.0" - magit-log-edit-confirm-cancellation t - magit-omit-untracked-dir-contents t - magit-process-connection-type nil - magit-push-always-verify nil - magit-repository-directories - '(("/home/jao/usr/bigml" . 2) - ("/home/jao/usr/jao" . 2) - ("/home/jao/lib/elisp" . 3) - ("/usr/local/src" . 1)) - magit-save-repository-buffers 'dontask - magit-section-visibility-indicator '("…" . t) - magit-status-buffer-switch-function 'switch-to-buffer - magit-status-show-hashes-in-headers t) - :config - - (use-package forge - :ensure t - :demand t - :init - (setq forge-topic-list-limit (cons 100 -1) - forge-pull-notifications nil)) - - (add-hook 'magit-status-sections-hook #'forge-insert-assigned-pullreqs t) - (add-hook 'magit-status-sections-hook #'forge-insert-assigned-issues t) - - :bind (("<f2>" . magit-status) - (:map forge-topic-mode-map ("M-w" . copy-region-as-kill)))) - - (use-package code-review - :ensure t - :after forge - :bind (:map magit-status-mode-map - ("C-c C-r" . code-review-forge-pr-at-point))) - - - #+end_src -*** Eldoc for magit status/log buffers - [[https://tsdh.org/posts/2021-06-21-using-eldoc-with-magit.html][Using Eldoc with Magit]]. - #+begin_src emacs-lisp - (defun jao-magit-eldoc-for-commit (_callback) - (when-let ((commit (magit-commit-at-point))) - (with-temp-buffer - (magit-git-insert "show" - "--format=format:%an <%ae>, %ar" - (format "--stat=%d" (window-width)) - commit) - (goto-char (point-min)) - (put-text-property (point-min) (line-end-position) 'face 'bold) - (buffer-string)))) - - (defun jao-magit-eldoc-setup () - (add-hook 'eldoc-documentation-functions - #'jao-magit-eldoc-for-commit nil t) - (eldoc-mode 1)) - - (add-hook 'magit-log-mode-hook #'jao-magit-eldoc-setup) - (add-hook 'magit-status-mode-hook #'jao-magit-eldoc-setup) - - (with-eval-after-load "eldoc" - (eldoc-add-command 'magit-next-line) - (eldoc-add-command 'magit-previous-line) - (eldoc-add-command 'magit-section-forward) - (eldoc-add-command 'magit-section-backward)) - #+end_src -*** Other git packages - #+begin_src emacs-lisp - (use-package git-timemachine :ensure t) - - ;; git config --local git-link.remote / git-link.branch - (use-package git-link :ensure t) - - (use-package git-modes :ensure t) - - #+end_src -*** Jenkins - [[https://github.com/rmuslimov/jenkins.el][GitHub - rmuslimov/jenkins.el: Jenkins plugin for emacs]] - #+BEGIN_SRC emacs-lisp - (use-package jenkins - :ensure t - :init - ;; one also needs jenkins-api-token, jenkins-username and jenkins-url - ;; optionally: jenkins-colwidth-id, jenkins-colwidth-last-status - (setq jenkins-colwidth-name 35) - :config - (defun jao-jenkins-first-job (&rest _) - (interactive) - (goto-char (point-min)) - (when (re-search-forward "^- Job" nil t) - (goto-char (match-beginning 0)))) - (add-hook 'jenkins-job-view-mode-hook #'jao-jenkins-first-job) - (advice-add 'jenkins-job-render :after #'jao-jenkins-first-job) - - (defun jenkins-refresh-console-output () - (interactive) - (let ((n (buffer-name))) - (when (string-match "\\*jenkins-console-\\([^-]+\\)-\\(.+\\)\\*$" n) - (jenkins-get-console-output (match-string 1 n) (match-string 2 n)) - (goto-char (point-max))))) - - :bind (:map jenkins-job-view-mode-map - (("n" . next-line) - ("p" . previous-line) - ("f" . jao-jenkins-first-job) - ("RET" . jenkins--show-console-output-from-job-screen)) - :map jenkins-console-output-mode-map - (("n" . next-line) - ("p" . previous-line) - ("g" . jenkins-refresh-console-output)))) - #+END_SRC -* Programming -*** Automatic modes - #+BEGIN_SRC emacs-lisp - (add-to-list 'auto-mode-alist '("\\.mix\\'" . hexl-mode)) - (add-to-list 'auto-mode-alist '("\\.m4\\'" . m4-mode)) - (add-to-list 'auto-mode-alist '("\\.am\\'" . makefile-mode)) - (add-to-list 'auto-mode-alist '("\\.pl\\'\\|\\.pm\\'" . cperl-mode)) - #+END_SRC -*** Smart scan - #+begin_src emacs-lisp - (use-package smartscan - :ensure t - :commands smartscan-mode - :init (add-hook 'prog-mode-hook #'smartscan-mode) - :diminish) - #+end_src -*** Paredit and parens - #+begin_src emacs-lisp - (require 'paren) - (show-paren-mode t) - (setq show-paren-context-when-offscreen t) - - (use-package paredit - :ensure t - :commands paredit-mode - :hook ((pie-mode . paredit-mode) - (scheme-mode . paredit-mode) - (clojure-mode . paredit-mode) - (emacs-lisp-mode . paredit-mode) - (eval-expression-minibuffer-setup . paredit-mode) - (lisp-interaction-mode . disable-paredit-mode)) - :diminish ((paredit-mode . " þ"))) - #+end_src -*** Diff/Ediff - #+BEGIN_SRC emacs-lisp - (setq ediff-split-window-function 'split-window-horizontally) - (setq ediff-make-buffers-readonly-at-startup nil) - (setq ediff-window-setup-function 'ediff-setup-windows-plain) - (setq ediff-keep-variants nil) - #+END_SRC -*** Compilation -***** Compilation mode options - #+begin_src emacs-lisp - (require 'compile) - (setq compilation-scroll-output t) - (setq compilation-error-regexp-alist - (remove 'omake compilation-error-regexp-alist)) - ;; (add-hook 'compilation-mode-hook #'visual-line-mode) - #+end_src -***** Mode line (no "Compiling"!) - #+BEGIN_SRC emacs-lisp - (require 'compile) - (diminish 'compilation-minor-mode " ‡") - (when (< emacs-major-version 27) - (setcdr (assq 'compilation-in-progress minor-mode-alist) '(" ‡"))) - (when (> emacs-major-version 26) - (setcdr (assq 'compilation-in-progress mode-line-modes) '("‡ "))) - #+END_SRC -***** Colorizing compilation buffer - #+begin_src emacs-lisp - (setq compilation-message-face 'default) - (require 'ansi-color) - (defun endless/colorize-compilation () - "Colorize from `compilation-filter-start' to `point'." - (let ((inhibit-read-only t)) - (ansi-color-apply-on-region - compilation-filter-start (point)))) - - (add-hook 'compilation-filter-hook #'endless/colorize-compilation) - #+end_src -***** Compilation commands - #+begin_src emacs-lisp - (use-package jao-compilation - :commands jao-compilation-setup - :bind (("C-c C" . compile) - ("C-c c" . jao-compile))) - (jao-compilation-setup) - #+end_src -***** Next error - #+begin_src emacs-lisp - (setq next-error-find-buffer-function - #'next-error-buffer-on-selected-frame - next-error-verbose t) - #+end_src -*** Flymake - #+begin_src emacs-lisp - (use-package flymake - :ensure t - :custom ((flymake-mode-line-format '(" " flymake-mode-line-counters))) - :hook ((haskell-mode . flymake-mode)) - :config (jao-define-attached-buffer "^\\*Flymake diagnostics .*\\*\\'") - :bind (:map flymake-mode-map (("s-f n" . flymake-goto-next-error) - ("s-f p" . flymake-goto-prev-error) - ("s-f i" . flymake-show-diagnostic) - ("s-f f" . flymake-show-diagnostics-buffer) - ("s-f l" . consult-flymake)))) - #+end_src -*** Workarounds - #+begin_src emacs-lisp - (setq c-type-finder-time-slot nil) - #+end_src -* Programming languages -*** Elisp - #+begin_src emacs-lisp - (use-package edit-list :ensure t) - (use-package package-lint :ensure t) - - (defun elisp-disassemble (function) - (interactive (list (function-called-at-point))) - (disassemble function)) - - (defun elisp-pp (sexp) - (with-output-to-temp-buffer "*Pp Eval Output*" - (pp sexp) - (with-current-buffer standard-output - (emacs-lisp-mode)))) - - (defun elisp-macroexpand (form) - (interactive (list (form-at-point 'sexp))) - (elisp-pp (macroexpand form))) - - (defun elisp-macroexpand-all (form) - (interactive (list (form-at-point 'sexp))) - (elisp-pp (macroexpand-all form))) - - (defun elisp-find-definition (name) - (interactive (list (thing-at-point 'symbol))) - (cond (name - (let ((symbol (intern-soft name)) - (search (lambda (fun sym) - (let* ((r (save-excursion (funcall fun sym))) - (buffer (car r)) - (point (cdr r))) - (cond ((not point) - (error "Found no definition for %s in %s" - name buffer)) - (t - (switch-to-buffer buffer) - (goto-char point) - (recenter 1))))))) - (cond ((fboundp symbol) - (xref-push-marker-stack) - (funcall search 'find-function-noselect symbol)) - ((boundp symbol) - (xref-push-marker-stack) - (funcall search 'find-variable-noselect symbol)) - (t - (message "Symbol not bound: %S" symbol))))) - (t (message "No symbol at point")))) - - - (defun elisp-bytecompile-and-load () - (interactive) - (or buffer-file-name - (error "The buffer must be saved in a file first")) - (require 'bytecomp) - ;; Recompile if file or buffer has changed since last compilation. - (when (and (buffer-modified-p) - (y-or-n-p (format "save buffer %s first? " (buffer-name)))) - (save-buffer)) - (let ((filename (expand-file-name buffer-file-name))) - (with-temp-buffer - (byte-compile-file filename t)))) - - (use-package elisp-mode - :bind (:map emacs-lisp-mode-map - (("C-c C-M" . emacs-lisp-macroexpand) - ("C-c C-m" . elisp-macroexpand-all) - ("C-c C-k" . elisp-bytecompile-and-load) - ("C-c C-p" . pp-eval-last-sexp) - ("M-." . elisp-find-definition) - ("M-," . pop-tag-mark) - ("C-c <" . lc-show-package-summary)))) - #+end_src -*** Erlang - #+begin_src emacs-lisp - (use-package erlang - :disabled t - :ensure t - :custom ((inferior-erlang-machine-options '("shell")) - (inferior-erlang-machine "rebar3") - (inferior-erlang-shell-type nil) - (erlang-indent-level 4)) - - ;; :bind (:map erlang-mode-map (("C-c C-z" . jao-vterm-repl-pop-to-repl))) - - :init - ;; (require 'jao-vterm-repl) - ;; (add-to-list 'auto-mode-alist '("^rebar\\.config\\`" . erlang-mode)) - ;; (jao-vterm-repl-register "rebar.config" "rebar3 shell" "^[0-9]+> ") - - :config - ;; (defun jao-erlang-current-module () - ;; (when (save-excursion (goto-char (point-min)) - ;; (re-search-forward "^-module(\\([^)]+\\))" nil t)) - ;; (match-string-no-properties 1))) - - ;; (defun jao-erlang-compile (arg) - ;; (interactive "P") - ;; (save-some-buffers) - ;; (when-let ((mname (jao-erlang-current-module))) - ;; (with-current-buffer (jao-vterm-repl) - ;; (vterm-send-string (format "c(%s).\n" mname)) - ;; (sit-for 0) - ;; (setq compilation-last-buffer (current-buffer)) - ;; (when arg (jao-vterm-repl-pop-to-repl))))) - - ;; (setq erlang-shell-function #'jao-vterm-repl - ;; erlang-shell-display-function #'jao-vterm-repl-pop-to-repl - ;; erlang-compile-function #'jao-erlang-compile) - ) - #+end_src -*** Idris - #+begin_src emacs-lisp - (use-package idris-mode - :ensure t - :custom ((idris-interpreter-path "idris2") - (idris-pretty-printer-width 80) - (idris-repl-history-file "~/.emacs.d/cache/idris-history.eld") - (idris-stay-in-current-window-on-compiler-error t))) - (jao-define-attached-buffer "^\\*idris.*") - #+end_src -*** Clojure - #+begin_src emacs-lisp - (use-package clojure-mode - :ensure t - :config - (defun jao-clojure--fix-things () - (setq-local completion-styles '(basic partial-completion emacs22)) - (eldoc-mode 1) - (setq mode-name "λ")) - :hook (clojure-mode . jao-clojure--fix-things)) - - (use-package cider - :ensure t - :commands cider-mode - :init (setq cider-annotate-completion-candidates t - cider-auto-select-error-buffer nil - cider-auto-select-test-report-buffer nil - cider-eldoc-display-for-symbol-at-point t - cider-eldoc-ns-function #'cider-last-ns-segment - cider-enrich-classpath nil - cider-lein-parameters "repl :headless :host localhost" - cider-mode-line " ÷" - cider-prompt-for-symbol nil - cider-repl-history-file - (expand-file-name "~/.emacs.d/cache/cider.history") - cider-repl-pop-to-buffer-on-connect nil - cider-repl-use-pretty-printing t - cider-show-error-buffer 'except-in-repl - cider-test-show-report-on-success nil - cider-use-fringe-indicators nil - cider-use-overlays nil - clojure-docstring-fill-column 72 - nrepl-prompt-to-kill-server-buffer-on-quit nil)) - - (with-eval-after-load "cider-test" - (advice-add 'cider-scale-background-color :override - (lambda () (frame-parameter nil 'background-color))) - (setq cider-test-items-background-color - (frame-parameter nil 'background-color))) - - (use-package cider-macroexpansion - :after cider - :diminish " µ") - - #+end_src -*** Geiser - #+begin_src emacs-lisp - (defun jao-org--set-geiser-impl () (setq-local geiser-repl--impl 'guile)) - (add-hook 'org-mode-hook #'jao-org--set-geiser-impl) - - (jao-load-path "geiser/geiser/elisp") - (use-package geiser - :init - (setq geiser-repl-history-filename "~/.emacs.d/cache/geiser-history" - geiser-repl-startup-time 20000 - geiser-debug-auto-display-images-p t - geiser-log-verbose-p t - geiser-active-implementations '(guile) - geiser-default-implementation 'guile)) - - (jao-load-path "geiser/guile") - (use-package geiser-guile) - - ;; (jao-load-path "geiser/mit") - ;; (use-package geiser-mit) - - ;; (jao-load-path "geiser/chicken") - ;; (use-package geiser-chicken) - - ;; (jao-load-path "geiser/chibi") - ;; (use-package geiser-chibi) - - ;; (jao-load-path "geiser/chez") - ;; (use-package geiser-chez - ;; :init (setq geiser-chez-binary "scheme")) - - ;; (jao-load-path "geiser/gambit") - ;; (use-package geiser-gambit) - - ;; (jao-load-path "geiser/gauche") - ;; (use-package geiser-gauche) - - (jao-define-attached-buffer "^\\* ?Geiser .*\\*" 0.4) - (jao-define-attached-buffer "^\\* Guile REPL \\*" 0.4) - - #+end_src -*** Haskell -***** packages - #+begin_src emacs-lisp - (use-package haskell-mode - :ensure t - :custom - ((inferior-haskell-find-project-root t) - (haskell-check-remember-last-command-p nil) - (haskell-font-lock-symbols nil) - (haskell-interactive-popup-errors nil) - (haskell-process-auto-import-loaded-modules t) - (haskell-process-log t) - (haskell-process-suggest-remove-import-lines t) - (haskell-process-suggest-hoogle-imports t) - (haskell-process-type 'cabal-repl) - (haskell-process-use-presentation-mode t) - (haskell-stylish-on-save nil)) - - :config - (defun jao-haskell-hoogle (query) - (interactive (hoogle-prompt)) - (haskell-hoogle query t)) - - (put 'haskell-process-args-cabal-repl - 'safe-local-variable - (apply-partially #'seq-every-p #'stringp)) - - (require 'haskell-doc) - (dolist (h '(interactive-haskell-mode - haskell-doc-mode - haskell-decl-scan-mode - haskell-indentation-mode - haskell-auto-insert-module-template)) - (add-hook 'haskell-mode-hook h)) - - :bind (:map haskell-mode-map - (("C-c C-d" . jao-haskell-hoogle) - ("C-c h" . haskell-hoogle-lookup-from-local) - ("C-c C-c" . haskell-compile)))) - - (require 'haskell) - - (diminish 'interactive-haskell-mode " λ") - (diminish haskell-doc-mode) - (diminish haskell-decl-scan-mode) - - (jao-define-attached-buffer "\\*hoogle\\*.*") - - ;; needs cabal install apply-refact - (use-package hlint-refactor - :ensure t - :after (haskell-mode) - :diminish "" - :hook (haskell-mode . hlint-refactor-mode)) - #+end_src -***** transient - #+begin_src emacs-lisp - (jao-transient-major-mode haskell - ["Imports" - ("in" "Navigate imports" haskell-navigate-imports) - ("if" "Format imports" haskell-mode-format-imports) - ("is" "Sort imports" haskell-sort-imports) - ("ia" "Align imports" haskell-align-imports)] - ["Code" - ("c" "Compile" haskell-compile) - ("s" "stylish on buffer" haskell-mode-stylish-buffer)] - ["Hoogle" - ("h" "Hoogle" jao-haskell-hoogle) - ("H" "Hoogle from local server" haskell-hoogle-lookup-from-local)]) - #+end_src -*** Pie - #+begin_src emacs-lisp - (jao-load-path "pie") - (use-package pie - :demand t - :commands (pie-mode)) - #+end_src -*** Lisp - #+begin_src emacs-lisp :tangle no - (use-package sly - :ensure t - :init (setq inferior-lisp-program "sbcl") - :config (sly-setup)) - - (use-package sly-quicklisp - :after (sly) - :ensure t) - #+end_src -*** Prolog - #+BEGIN_SRC emacs-lisp - (use-package ediprolog :ensure t) - - (use-package prolog - :ensure t - :commands (run-prolog prolog-mode mercury-mode) - :init (progn - (setq prolog-system 'swi) - (add-to-list 'auto-mode-alist '("\\.pl$" . prolog-mode)) - (setq prolog-consult-string '((t "[%f]."))) - (setq prolog-program-name - '(((getenv "EPROLOG") (eval (getenv "EPROLOG"))) - (eclipse "eclipse") - (mercury nil) - (sicstus "sicstus") - (swi "swipl") - (t "prolog"))))) - #+END_SRC -*** Racket - #+begin_src emacs-lisp - (use-package racket-mode - :ensure t - :init (setq racket-show-functions '(racket-show-echo-area) - racket-documentation-search-location 'local) - :config - (jao-define-attached-buffer "\\`\\*Racket REPL") - (jao-define-attached-buffer "\\`\\*Racket Describe" 0.5) - (add-hook 'racket-mode-hook #'paredit-mode) - (require 'racket-xp) - (add-hook 'racket-mode-hook #'racket-xp-mode) - :bind (:map racket-xp-mode-map (("C-c C-S-d" . racket-xp-documentation) - ("C-c C-d" . racket-xp-describe)))) - - #+end_src -*** Python -***** Virtual envs (with eshell support) - See also [[https://github.com/porterjamesj/virtualenvwrapper.el][the docs]]. - #+begin_src emacs-lisp - (use-package virtualenvwrapper - :ensure t - :config - (venv-initialize-eshell) - (jao-compilation-env "VIRTUAL_ENV")) - #+end_src -* Text/data formats -*** YAML - #+begin_src emacs-lisp - (use-package yaml-mode :ensure t) - #+end_src -*** JSON - #+BEGIN_SRC emacs-lisp - (use-package json-mode :ensure t) - ;; (use-package json-navigator :ensure nil) - #+END_SRC -* Graphics -*** Images - #+begin_src emacs-lisp - (setq image-use-external-converter t) - #+end_src -*** Gnuplot - #+BEGIN_SRC emacs-lisp - (use-package gnuplot - :ensure t - :commands (gnuplot-mode gnuplot-make-buffer) - :init (add-to-list 'auto-mode-alist '("\\.gp$" . gnuplot-mode))) - #+END_SRC -*** Maps - #+begin_src emacs-lisp - (use-package osm - :ensure t - :init - (with-eval-after-load 'org (require 'osm-ol)) - :config - (transient-define-prefix jao-transient-osm () - ["Open Street Maps" - ("s" "search" osm-search) - ("g" "goto" osm-goto) - ("b" "jump to bookmark" osm-bookmark-jump) - ("t" "server" osm-server)]) - :bind ("C-c M" . #'jao-transient-osm)) - #+end_src -* Network -*** nm applet - #+begin_src emacs-lisp - (jao-shell-def-exec jao-nm-applet "nm-applet") - - (defun jao-toggle-nm-applet () - (interactive) - (if (jao-shell-running-p "nm-applet") - (jao-shell-string "killall nm-applet") - (jao-nm-applet))) - #+end_src -*** enwc - #+begin_src emacs-lisp - (use-package enwc - :ensure t - :custom ((enwc-default-backend 'nm) - (enwc-wired-device "wlp164s0") - (enwc-wireless-device "wlp164s0") - (enwc-display-mode-line nil))) - #+end_src - -*** bluetooth - #+BEGIN_SRC emacs-lisp - (use-package bluetooth :ensure t) - #+END_SRC -*** vpn - #+begin_src emacs-lisp - (use-package jao-mullvad :demand t) - #+end_src -*** ssh - #+begin_src emacs-lisp - (use-package tramp) - (defun jao-tramp-hosts () - (seq-uniq - (mapcan (lambda (x) - (remove nil (mapcar 'cadr (apply (car x) (cdr x))))) - (tramp-get-completion-function "ssh")) - #'string=)) - - (defun jao-ssh () - (interactive) - (let ((h (completing-read "Host: " (jao-tramp-hosts)))) - (jao-afio-goto-scratch) - (jao-exec-in-term (format "ssh %s" h) (format "*ssh %s*" h)))) - #+end_src -* Chats -*** erc -**** package - #+begin_src emacs-lisp - (use-package erc - :init - (setq erc-modules - '(autojoin - button - dcc - fill - irccontrols - match - move-to-prompt - netsplit - networks - noncommands - notify - pcomplete - ring - services - stamp - track - truncate)) - - (setq erc-auto-query 'bury - erc-autojoin-channels-alist `(("libera.chat" ,@jao-libera-channels)) - erc-away-nickname "jao" - erc-button-buttonize-nicks t - erc-common-server-suffixes '(("libera.chat$" . "lb")) - erc-current-nick-highlight-type 'nick-or-keyword - erc-email-userid (car jao-mails) - erc-fill-column 84 - erc-fill-prefix " " - erc-format-nick-function 'erc-format-@nick - erc-header-line-face-method t - erc-header-line-format nil ;; "%l %o" - erc-header-line-uses-tabbar-p nil - erc-hide-list '("JOIN" "PART" "QUIT") - erc-hide-timestamps nil - erc-input-line-position -1 - erc-insert-timestamp-function 'erc-insert-timestamp-right - erc-join-buffer 'bury - erc-kill-buffer-on-part t - erc-kill-queries-on-quit t - erc-log-channels-directory nil - erc-mode-line-away-status-format "(a)" - erc-mode-line-format "%t" - erc-nick "jao" - erc-notice-highlight-type 'all - erc-notice-prefix "- " - erc-notify-signoff-hook 'erc-notify-signoff - erc-notify-signon-hook 'erc-notify-signon - erc-pcomplete-nick-postfix "," - erc-rename-buffers t - erc-server-send-ping-timeout 60 - erc-prompt ":" - erc-prompt-for-nickserv-password nil - erc-use-auth-source-for-nickserv-password t - erc-prompt-for-password nil - erc-public-away-p t - erc-server "irc.libera.chat" - erc-server-coding-system '(utf-8 . undecided) - erc-server-reconnect-attempts 10 - erc-server-reconnect-timeout 10 - erc-timestamp-format "%H:%M" - erc-timestamp-only-if-changed-flag t - erc-timestamp-right-column 84 - erc-user-full-name "https://jao.io" - erc-user-mode "+i" - erc-whowas-on-nosuchnick t) - - :config - - (define-minor-mode ncm-erc-mode "" nil - (:eval (format " [%s]" (hash-table-count erc-channel-users)))) - - (add-hook 'erc-mode-hook (lambda () (ncm-erc-mode 1))) - (add-hook 'erc-mode-hook (lambda () (auto-fill-mode -1)))) - #+end_src -**** no angles - #+begin_src emacs-lisp - (defun jao-erc--no-angles (old-func &rest args) - (let ((msg (apply old-func args))) - (replace-regexp-in-string "^<\\([^>]+\\)>" "(\\1)" msg))) - - (with-eval-after-load "erc" - (modify-syntax-entry ?\( "." erc-mode-syntax-table) - (modify-syntax-entry ?\) "." erc-mode-syntax-table) - (advice-add 'erc-format-privmessage :around #'jao-erc--no-angles) - (advice-add 'erc-format-my-nick :around #'jao-erc--no-angles)) - #+end_src -**** tracking - #+begin_src emacs-lisp - (defun jao-erc-track-shorten (names) - (let ((names (erc-track-shorten-names names))) - (mapcar (lambda (n) (string-remove-prefix "#" n)) names))) - - (setq erc-track-exclude-server-buffer t - erc-track-exclude-types '("NICK" "JOIN" "PART" "QUIT" "MODE" "KICK") - erc-track-remove-disconnected-buffers t - erc-track-shorten-aggressively t ;; 'max - erc-track-shorten-function #'jao-erc-track-shorten - erc-track-switch-direction 'importance - erc-track-visibility nil ;; t all, nil only selected frame - erc-track-position-in-mode-line nil - erc-track-enable-keybindings nil ;; 'ask - erc-track-faces-priority-list '(erc-error-face - erc-current-nick-face - erc-pal-face - erc-direct-msg-face - erc-nick-msg-face - erc-default-face - erc-action-face - erc-notice-face)) - (defun jao-track-erc-buffers () - (dolist (e erc-modified-channels-alist) - (tracking-add-buffer (car e) (list (cddr e))))) - - (with-eval-after-load "erc-track" - (require 'tracking nil t) - (add-hook 'exwm-workspace-switch-hook #'erc-modified-channels-update) - (add-hook 'erc-track-list-changed-hook #'jao-track-erc-buffers)) - - (jao-shorten-modes 'erc-mode) - (jao-tracking-faces 'erc-error-face - 'erc-pal-face - 'erc-current-nick-face - 'erc-direct-msg-face) - #+end_src -**** commands (/recover &co.) - #+begin_src emacs-lisp - (defun erc-cmd-RECOVER (&rest ignore) - "Recover nick" - (let ((fn (jao--get-user/password "freenode"))) - (erc-cmd-MSG (format "nickserv IDENTIFY %s %s" (car fn) (cadr fn))) - (erc-cmd-MSG (format "nickserv GHOST %s" (car fn))) - (erc-cmd-MSG (format "nickserv RELEASE %s" (car fn))) - (erc-cmd-NICK (car fn)))) - #+end_src -**** startup - #+begin_src emacs-lisp - (defun jao-erc (&optional yes) - (interactive "P") - ;; (when (or yes (y-or-n-p "Connect to bitlbee using ERC? ")) - ;; (erc-select :server "localhost")) - (when (or yes (y-or-n-p "Connect to libera using ERC? ")) - (erc-select :server "irc.libera.chat"))) - #+end_src -*** circe - #+begin_src emacs-lisp - (defvar jao-libera-channels '()) - (defvar jao-oftc-channels '()) - (defvar jao-bitlbee-channels '()) - - (use-package circe - :ensure t - :bind (:map circe-channel-mode-map - (("C-c C-a" . lui-track-jump-to-indicator))) - :init - (setq circe-chat-buffer-name "{target}" - circe-default-realname "https://jao.io" - circe-default-part-message "" - circe-default-quit-message "" - circe-ignore-list nil - circe-server-coding-system '(undecided . undecided) - circe-server-killed-confirmation 'ask-and-kill-all - circe-server-auto-join-default-type :after-auth - circe-format-say "({nick}) {body}" - circe-format-self-say "(jao) {body}" - circe-new-buffer-behavior 'ignore - circe-new-buffer-behavior-ignore-auto-joins t - circe-nickserv-ghost-style 'after-auth - circe-prompt-string ": " - circe-completion-suffix ", " - circe-reduce-lurker-spam t - - circe-nick-next-function - (lambda (old) - (replace-regexp-in-string "-" "`" (circe-nick-next old))) - - circe-lagmon-mode-line-format-string "" ;; "%.0f " - circe-lagmon-mode-line-unknown-lag-string "" ;; "? " - circe-lagmon-timer-tick 120 - circe-lagmon-reconnect-interval 180 - - lui-max-buffer-size 30000 - lui-fill-column 80 - lui-time-stamp-position 'right - lui-time-stamp-format "%H:%M" - lui-flyspell-p nil - - lui-track-indicator 'fringe - lui-track-behavior 'before-tracking-next-buffer) - :config - - (defun circe-command-RECOVER (&rest ignore) - "Recover nick" - (let* ((fn (jao--get-user/password "freenode")) - (u (car fn)) - (p (cadr fn))) - (circe-command-MSG "nickserv" (format "IDENTIFY %s %s" u p)) - (circe-command-MSG "nickserv" (format "GHOST %s" u)) - (circe-command-MSG "nickserv" (format "RELEASE %s" u)) - (circe-command-NICK u))) - - (defun circe-command-NNICKS (&rest _) - "Echo number of nicks" - (circe-display-server-message - (format "%d nicks in this channel" (length (circe-channel-nicks))))) - - (advice-add 'circe-command-NAMES :after #'circe-command-NNICKS) - - (setq circe-network-options - (let ((up (jao--get-user/password "libera")) - (oup (jao--get-user/password "oftc")) - (bup (jao--get-user/password "bitlbee"))) - `(("Libera Chat" - :nick ,(car up) :channels ,jao-libera-channels - :tls t :sasl-username ,(car up) :sasl-password ,(cadr up)) - ("OFTC" :nick ,(car oup) :channels ,jao-oftc-channels - :nickserv-password ,(cadr oup) - :tls t :sasl-username ,(car oup) :sasl-password ,(cadr oup)) - ("Bitlbee" - :host "127.0.0.1" :nick ,(car bup) - :channels ,jao-bitlbee-channels - :lagmon-disabled t - :nickserv-password ,(cadr bup) :user ,(car bup))))) - - (jao-shorten-modes 'circe-channel-mode - 'circe-server-mode - 'circe-query-mode) - - (enable-lui-track) - (circe-lagmon-mode) - (enable-circe-display-images)) - #+end_src -*** slack - [[https://github.com/jackellenberger/emojme#finding-a-slack-token][How to get a token]]: It's easyish! Open and sign into the slack - customization page, e.g. https://my.slack.com/customize, right - click anywhere > inspect element. Open the console and paste: - - =window.prompt("your api token is: ", TS.boot_data.api_token)= - - Lately things are iffy. We've needed to add the ~:override~ to - slack-counts update, and it might be needed to replace - ~slack-conversations-view~ by ~slack-conversations-history~ - - #+begin_src emacs-lisp - (use-package slack - :commands (slack-start) - :init - (setq slack-alert-icon (jao-data-file "slack.svg") - slack-buffer-emojify nil - slack-buffer-create-on-notify t - slack-display-team-name t - slack-typing-visibility 'never ;; 'buffer, 'frame - slack-profile-image-file-directory "/tmp/slack-imgs/" - slack-image-file-directory "/tmp/slack-imgs/" - slack-file-dir "~/var/download/slack/" - slack-prefer-current-team t - slack-message-tracking-faces '(warning) - slack-log-level 'warn - slack-message-custom-notifier (lambda (msg room team) room)) - :bind (:map slack-mode-map (("@" . slack-message-embed-mention) - ("#" . slack-message-embed-channel)) - :map slack-message-buffer-mode-map - (("C-c C-e" . slack-message-edit) - ("C-c C-a" . slack-file-upload))) - :config - (dolist (f (list slack-file-dir slack-image-file-directory)) - (when (not (file-exists-p f)) (make-directory f))) - - (jao-shorten-modes 'slack-message-buffer-mode - 'slack-thread-message-buffer-mode) - (jao-tracking-faces 'warning) - - (jao-define-attached-buffer "\\*Slack .+ Edit Message [0-9].+" 20)) - #+end_src -*** telegram - #+begin_src emacs-lisp - (use-package telega - :ensure t - :custom - (telega-use-tracking-for '(unmuted) ;; '(or unmuted mention) - telega-rainbow-color-custom-for nil - telega-msg-rainbow-title nil - telega-sticker-set-download t) - :config - (define-key global-map (kbd "C-c C-t") telega-prefix-map) - (setq telega-chat-show-avatars nil - telega-chat-prompt-format ">> " - telega-root-show-avatars nil - telega-emoji-use-images nil - telega-temp-dir "/tmp/telega" - telega-symbol-checkmark "·" - telega-symbol-heavy-checkmark "×" - telega-symbol-verified "*" - telega-mode-line-string-format - '(:eval (telega-mode-line-unread-unmuted))) - (with-eval-after-load "tracking" - (jao-shorten-modes 'telega-chat-mode) - (jao-tracking-faces 'telega-tracking)) - (telega-mode-line-mode 1)) - #+end_src -*** startup - #+begin_src emacs-lisp - (defun jao-chats (&optional p) - (interactive "P") - (when (or p (y-or-n-p "Connect to slack? ")) - (slack-start)) - (when (or p (y-or-n-p "Connect to telegram? ")) - (telega)) - (when (or p (y-or-n-p "Connect to libera? ")) - ;; (unless (get-buffer "irc.libera.chat:6697") - ;; (circe "Libera Chat")) - ;; (unless (get-buffer "Libera.Chat") - ;; (jao-erc t)) - )) - - (defun jao-all-chats () (interactive) (jao-chats t)) - - (defun jao-chats-telega () - (interactive) - (jao-buffer-same-mode '(telega-root-mode telega-chat-mode))) - - (defun jao-chats-slack () - (interactive) - (jao-buffer-same-mode 'slack-message-buffer-mode)) - - (defun jao-chats-irc () - (interactive) - (jao-buffer-same-mode '(circe-channel-mode circe-query-mode erc-mode))) - - #+end_src -* Multimedia -*** mixer - #+begin_src emacs-lisp - (defun jao-mixer-get-level (&optional dev) - (interactive) - (let* ((dev (or dev "Master")) - (s (shell-command-to-string (format "amixer sget %s" dev))) - (s (car (last (split-string s "\n" t))))) - (when (string-match ".*Front .*\\[\\([0-9]+\\)%\\] .*" s) - (let ((level (match-string 1 s))) - (message "%s level: %s%%" dev level) - (string-to-number level))))) - - (defun jao-mixer-set (dev v) - (jao-shell-string "amixer sset" dev v) - (jao-mixer-get-level dev)) - - (defun jao-mixer-master-toggle () - (interactive) - (jao-mixer-set "Master" "toggle")) - - (defun jao-mixer-master-up () - (interactive) - (jao-mixer-set "Master" "10%+")) - - (defun jao-mixer-master-down () - (interactive) - (jao-mixer-set "Master" "10%-")) - - (defun jao-mixer-capture-up () - (interactive) - (jao-mixer-set "Capture" "10%+")) - - (defun jao-mixer-capture-down () - (interactive) - (jao-mixer-set "Capture" "10%-")) - - (jao-shell-def-exec jao-audio-applet "pasystray") - - (defun jao-toggle-audio-applet () - (interactive) - (if (string-empty-p (jao-shell-string "pidof pasystray")) - (jao-audio-applet) - (jao-shell-string "killall pasystray"))) - - (global-set-key (kbd "<f4>") #'jao-toggle-audio-applet) - - #+end_src -*** mpris - #+begin_src emacs-lisp - (defun jao-mpris-lyrics (&optional force) - (interactive "P") - (jao-show-lyrics force #'jao-mpris-artist-title)) - - (use-package jao-mpris :demand t) - - (defalias 'jao-streaming-list - (if jao-sway-enabled #'jao-sway-run-or-focus-deezer #'ignore)) - (defalias 'jao-streaming-like #'ignore) - (defalias 'jao-streaming-dislike #'ignore) - (defalias 'jao-streaming-lyrics #'jao-mpris-lyrics) - (defalias 'jao-streaming-toggle #'jao-mpris-play-pause) - (defalias 'jao-streaming-next #'jao-mpris-next) - (defalias 'jao-streaming-prev #'jao-mpris-previous) - (defalias 'jao-streaming-current #'jao-mpris-show-osd) - (defalias 'jao-streaming-seek #'jao-mpris-seek) - (defalias 'jao-streaming-seek-back #'jao-mpris-seek-back) - (defalias 'jao-streaming-volume #'jao-mpris-vol) - (defalias 'jao-streaming-volume-down #'jao-mpris-vol-down) - - (jao-mpris-register "playerctld" - :session (if jao-modeline-in-minibuffer -10 70)) - - #+end_src -*** mpc - #+begin_src emacs-lisp - (use-package jao-mpc - :demand t - :commands jao-mpc-setup) - - ;; (defvar jao-mopidy-port 6669) - (defvar jao-mopidy-port nil) - (jao-mpc-setup jao-mopidy-port (if jao-modeline-in-minibuffer -10 70)) - - (defun jao-mpc-pport () - (when (jao-mpc--playing-p jao-mopidy-port) jao-mopidy-port)) - - (defmacro jao-defun-play (name &optional mpc-name) - `(defun ,(intern (format "jao-player-%s" name)) () - (interactive) - (,(intern (format "jao-mpc-%s" (or mpc-name name))) (jao-mpc-pport)))) - - (jao-defun-play toggle) - (jao-defun-play next) - (jao-defun-play previous) - (jao-defun-play stop) - (jao-defun-play echo echo-current) - (jao-defun-play list show-playlist) - (jao-defun-play info lyrics-track-data) - - (defun jao-player-seek (delta) (jao-mpc-seek delta (jao-mpc-pport))) - - (defalias 'jao-player-browse 'jao-mpc-show-albums) - (defalias 'jao-player-connect 'jao-mpc-connect) - (defalias 'jao-player-play 'jao-mpc-play) - #+end_src -*** transients - #+begin_src emacs-lisp - - (require 'jao-lyrics) - (setq jao-lyrics-info-function #'jao-player-info) - - (defun jao-player-volume-delta (raise) - (jao-player-vol-delta (if raise 5 -5)) - (sit-for 0.05) - (jao-player-show-volume)) - - (defun jao-player-volume-raise () - (interactive) - (jao-player-volume-delta t)) - - (defun jao-player-volume-lower () - (interactive) - (jao-player-volume-delta nil)) - - (defun jao-player-show-volume () - (interactive) - (jao-notify "Volume" (format "%s%%" (jao-player-volume)))) - - (defun jao-player-seek-10 () (interactive) (jao-player-seek 10)) - (defun jao-player-seek--10 () (interactive) (jao-player-seek -10)) - - (defun jao-streaming-clear () (interactive) (jao-mpc-clear jao-mopidy-port)) - - (defun jao-streaming-echo-current () - (interactive) - (jao-mpc-echo-current jao-mopidy-port)) - - (defun jao-streaming-show-playlist () - (interactive) - (jao-mpc-show-playlist jao-mopidy-port)) - - (defun jao-player-level-cap () (interactive) (jao-mixer-level "Capture")) - - (use-package jao-random-album :demand t) - - (jao-def-exec-in-term "aptitude" "aptitude" (jao-afio--goto-scratch)) - (jao-def-exec-in-term "htop" "htop" (jao-afio--goto-scratch)) - - (transient-define-prefix jao-transient-streaming () - [:description - (lambda () (format "Streaming using %s" jao-mpris-player)) - ;; ["Search" - ;; ("a" "album" jao-streaming-album) - ;; ("A" "artist" jao-streaming-artist) - ;; ("t" "track" jao-streaming-track) - ;; ("P" "playlist" jao-streaming-playlist)] - ["Play" - ("s" "toggle" jao-streaming-toggle) - ("n" "next" jao-streaming-next) - ("p" "previous" jao-streaming-prev)] - ["Seek & shout" - ("f" "seek fwd" jao-streaming-seek :transient t) - ("F" "seek bwd" jao-streaming-seek-back :transient t) - ("u" "up" jao-streaming-volume :transient t) - ("d" "down" jao-streaming-volume-down :transient t)] - ["Browse" - ("l" "playing list" jao-streaming-list) - ("L" "lyrics" jao-streaming-lyrics) - ("w" "currently playing" jao-streaming-current)] - ["Act" - ("k" "like" jao-streaming-like) - ("K" "dislike" jao-streaming-dislike)]]) - - (transient-define-prefix jao-transient-media () - [["Play" - ("m" "toggle" jao-player-toggle) - ("n" "next" jao-player-next) - ("p" "previous" jao-player-previous) - ("s" "toggle streaming" jao-streaming-toggle) - ] - ["Seek and search" - ("f" "seek fwd" jao-player-seek-10 :transient t) - ("F" "seek bwd" jao-player-seek--10 :transient t) - ("a" "select album" jao-mpc-select-album)] - ["Browse" - ("b" "browse" jao-player-browse) - ("l" "show play list" jao-player-list) - ("L" "show lyrics" jao-show-lyrics) - ("w" "now playing" jao-player-echo)] - ["Master volume" - ("d" "master down" jao-mixer-master-down :transient t) - ("u" "master up" jao-mixer-master-up :transient t) - ("M" "master toggle" jao-mixer-master-toggle) - ("v" "show" jao-mixer-get-level)] - ["Capture volume" - ("D" "capture down" jao-mixer-capture-down :transient t) - ("U" "capture up" jao-mixer-capture-up :transient t) - ("V" "show" jao-player-level-cap)] - ["Utilities" - ("c" "reconnect to mpd" jao-player-connect) - ("N" "next random album" jao-random-album-next) - ("r" (lambda () - (concat (if jao-random-album-p "dis" "en") "able random album")) - jao-random-album-toggle)]]) - - (global-set-key (kbd "s-m") #'jao-transient-media) - - #+end_src -* General transients - #+begin_src emacs-lisp - (defun jao-list-packages () - (interactive) - (jao-afio--goto-scratch-1) - (package-list-packages)) - - (transient-define-prefix jao-transient-utils () - "Global operations in X11." - [["Notes" - ("n" "capture note" jao-org-notes-open-or-create) - ("/" "search notes" jao-org-notes-open) - ("\\" "grep notes" jao-org-notes-grep)] - ["Documents" :if jao-window-system-p - ("d" "go to doc" jao-select-pdf) - ("D" "open to doc" jao-open-doc)] - ["Packages" - ("a" "aptitude" jao-term-aptitude) - ("l" "packages" jao-list-packages)] - ["Monitors" - ("p" "htop" jao-term-htop) - ("v" "vpn status" jao-mullvad-status) - ("m" "set tmr" tmr)] - ["Network" - ("S" "ssh" jao-ssh) - ("b" "bluetooth" bluetooth-list-devices) - ("c" "connect chats" jao-all-chats) - ("N" "network interfaces" enwc)] - ["Chats" - ("t" "telegram" jao-chats-telega) - ("s" "slack" jao-chats-slack) - ("i" "irc" jao-chats-irc) - ("T" "telegram rooster" telega)] - ["Window system" :if jao-window-system-p - ("w" "set wallpaper" jao-set-wallpaper) - ("W" "set radom wallpaper" jao-set-random-wallpaper) - ("x" "restart xmobar" jao-xmobar-restart :if jao-exwm-enabled-p) - ("x" "kill xmobar" jao-xmobar-kill :if jao-xmonad-enabled-p)] - ["Helpers" - ("r" "org reveal" org-reveal) - ("k" (lambda () (concat "keyboard" (when (jao-kb-toggled-p) "*"))) - jao-kb-toggle :if jao-window-system-p) - ("M" (lambda () (concat "minibuffer" (when jao-minibuffer-mode "*"))) - jao-minibuffer-mode)]]) - - (global-set-key (kbd "s-w") #'jao-transient-utils) - #+end_src -* Key bindings - #+begin_src emacs-lisp - (global-set-key "\C-cj" #'join-line) - (global-set-key "\C-cn" #'next-error) - (global-set-key "\C-cq" #'auto-fill-mode) - (global-set-key "\C-xr\M-w" #'kill-rectangle-save) - (global-set-key "\C-c\C-z" #'comment-or-uncomment-region) - (global-set-key "\C-z" #'comment-or-uncomment-region) - #+end_src -* Last minute (post.el) - #+begin_src emacs-lisp - (jao-load-site-el "post") - #+end_src diff --git a/lib/doc/jao-doc-session.el b/lib/doc/jao-doc-session.el new file mode 100644 index 0000000..877a8cb --- /dev/null +++ b/lib/doc/jao-doc-session.el @@ -0,0 +1,59 @@ +;;; jao-doc-session.el --- persistent document sessions -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2024 jao + +;; Author: jao <mail@jao.io> +;; Keywords: docs + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(persist-defvar jao-doc-session nil "Documents session") + +(defvar-local jao-doc-session--is-doc nil) + +(defun jao-doc-session-is-doc (&optional buffer) + "Check whether the given or current buffer belong to the doc session." + (buffer-local-value 'jao-doc-session--is-doc (or buffer (current-buffer)))) + +(defun jao-doc-session (&optional file) jao-doc-session) + +(defun jao-doc-session-save (&optional skip-current force) + "Traverse all current buffers and update the value of `jao-doc-session'." + (interactive) + (let ((docs '()) + (cb (and skip-current (current-buffer)))) + (dolist (b (buffer-list)) + (when-let (fs (and (not (eq cb b)) (jao-doc-session-is-doc b))) + (dolist (f fs) (add-to-list 'docs f)))) + (when (or force (> (length docs) 0)) + (setq jao-doc-session docs)))) + +(defun jao-doc-session-mark (&optional path) + "Mark the current buffer's file, or PATH, as persistent across sessions." + (unless (listp jao-doc-session--is-doc) + (setq jao-doc-session--is-doc (ensure-list jao-doc-session--is-doc))) + (cl-pushnew (or path (buffer-file-name)) jao-doc-session--is-doc) + (jao-doc-session-save)) + +(defun jao-doc-session--maybe-save () + (when (jao-doc-session-is-doc) (jao-doc-session-save t))) + +(defvar jao-doc-session-inhibit-save nil) + +(add-hook 'kill-buffer-hook #'jao-doc-session--maybe-save) + +(provide 'jao-doc-session) +;;; jao-doc-session.el ends here diff --git a/lib/doc/jao-doc-view.el b/lib/doc/jao-doc-view.el index ea55565..fe26c1d 100644 --- a/lib/doc/jao-doc-view.el +++ b/lib/doc/jao-doc-view.el @@ -1,4 +1,4 @@ -;; jao-doc-view.el -- Remembering visited documents -*- lexical-binding: t; -*- +;;; jao-doc-view.el -- extensions for doc-view -*- lexical-binding: t; -*- ;; Copyright (c) 2013, 2015, 2017, 2018, 2019, 2021, 2022 Jose Antonio Ortega Ruiz @@ -18,162 +18,32 @@ ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Fri Feb 15, 2013 01:21 -;;; Comentary: - -;; Some utilities to keep track of visited documents and their structure. - -;;; Code: - - -;;; Session - (require 'doc-view) +(require 'jao-pdf) -(defvar jao-doc-view-session-file "~/.emacs.d/cache/doc-view-session.eld") -(defvar-local jao-doc-view--is-doc nil) +;;; Utilities -(defun jao-doc-view-session-mark (path) (setq-local jao-doc-view--is-doc path)) -(defun jao-doc-view--is-doc () - (or jao-doc-view--is-doc - (when (derived-mode-p 'doc-view-mode 'pdf-view-mode 'nov-mode) - (buffer-file-name)))) - -(defun jao-doc-view--read-file (file) - (let ((buff (find-file-noselect file))) - (ignore-errors - (with-current-buffer buff - (goto-char (point-min))) - (read buff)))) - -(defun jao-doc-view--save-to-file (file value) - (with-current-buffer (find-file-noselect file) - (erase-buffer) - (insert (format "%S" value)) - (save-buffer))) - -(defun jao-doc-view-session (&optional file) - (let ((file (or file jao-doc-view-session-file))) - (jao-doc-view--read-file file))) - -(defun jao-doc-view-save-session (&optional skip-current) - (interactive) - (let ((docs '()) - (cb (when skip-current (current-buffer)))) - (dolist (b (buffer-list)) - (with-current-buffer b - (when-let (fn (and (not (eq cb b)) (jao-doc-view--is-doc))) - (add-to-list 'docs fn)))) - (when (> (length docs) 0) - (jao-doc-view--save-to-file jao-doc-view-session-file docs)))) - -(defun jao-doc-view--save-session-1 () - (when (jao-doc-view--is-doc) (jao-doc-view-save-session t))) - -(defvar jao-doc-view-inhibit-session-save nil) - -(defun jao-doc-view--save-session () - (let ((inhibit-message t) - (message-log-max nil)) - (when (not jao-doc-view-inhibit-session-save) - (jao-doc-view-save-session)) - t)) - -(add-hook 'kill-emacs-query-functions #'jao-doc-view--save-session) -(add-hook 'kill-buffer-hook #'jao-doc-view--save-session-1) -(add-hook 'doc-view-mode-hook #'jao-doc-view--save-session) -(add-hook 'pdf-view-mode-hook #'jao-doc-view--save-session) -(add-hook 'nov-mode-hook #'jao-doc-view--save-session) - - -;;; PDF info - -(defvar-local jao--pdf-outline nil) - -(defmacro jao-doc-view--pdf-call (a b &rest args) +(defmacro jao-doc-view--funcall (a b &rest args) `(cond ((derived-mode-p 'pdf-view-mode) (,a ,@args)) ((derived-mode-p 'doc-view-mode) (,b ,@args)))) -(defun jao-doc-view-is-pdf (file) (string-match-p ".*\\.pdf$" file)) - -(defun jao-doc-view-title->file (title) - (concat (mapconcat 'downcase (split-string title nil t) "-") ".pdf")) - (defun jao-doc-view-current-page () - (jao-doc-view--pdf-call pdf-view-current-page doc-view-current-page)) + (jao-doc-view--funcall pdf-view-current-page doc-view-current-page)) (defun jao-doc-view-goto-page (page &optional height) (when page - (jao-doc-view--pdf-call pdf-view-goto-page doc-view-goto-page page)) + (jao-doc-view--funcall pdf-view-goto-page doc-view-goto-page page)) (when (and height (derived-mode-p 'pdf-view-mode)) (image-set-window-vscroll (round (/ (* height (cdr (pdf-view-image-size))) (frame-char-height)))))) -(defun jao-doc-view-pdf-outline (&optional file-name) - (if (derived-mode-p 'pdf-view-mode) - (pdf-info-outline) - (let* ((outline nil) - (fn (or file-name (buffer-file-name) jao-doc-view--imenu-file)) - (fn (shell-quote-argument (expand-file-name fn)))) - (with-temp-buffer - (insert (shell-command-to-string (format "mutool show %s outline" fn))) - (goto-char (point-min)) - (while (re-search-forward ".+\\(\t+\\)\"\\(.+\\)\"\t#\\([0-9]+\\)," nil t) - (push `((level . ,(length (match-string 1))) - (title . ,(match-string 2)) - (page . ,(string-to-number (match-string 3)))) - outline))) - (nreverse outline)))) - -(defun jao-doc-view-section-title (&optional page file-name) - (when (not jao--pdf-outline) - (setq-local jao--pdf-outline (jao-doc-view-pdf-outline file-name))) - (let ((page (or page (jao-doc-view-current-page))) - (outline jao--pdf-outline) - (cur-page 0) - (cur-title (jao-doc-view-title (or file-name buffer-file-name "title")))) - (while (and (car outline) (< cur-page page)) - (setq cur-page (cdr (assoc 'page (car outline)))) - (when (<= cur-page page) - (setq cur-title (cdr (assoc 'title (car outline))))) - (setq outline (cdr outline))) - (replace-regexp-in-string "[[:blank:]]+" " " cur-title))) - -(defun jao-doc-view-title (&optional fname) - (if (or fname (not (derived-mode-p 'doc-view-mode 'pdf-view-mode))) - (let ((base (file-name-base (or fname (buffer-file-name))))) - (capitalize (replace-regexp-in-string "-" " " base))) - (or (jao-doc-view-section-title) - (when buffer-file-name (jao-doc-view-title buffer-file-name))))) - - ;;; imenu -(defvar-local jao-doc-view--imenu-file nil) -(defvar-local jao-doc-view--goer 'jao-doc-view-goto-page) - -(defun jao-doc-view--enable-imenu (&optional file-name goto-page) - (setq-local imenu-create-index-function #'jao-doc-view--imenu-create-index - jao-doc-view--imenu-file (or file-name jao-doc-view--imenu-file) - jao-doc-view--goer (or goto-page 'jao-doc-view-goto-page)) - (imenu-add-to-menubar "PDF outline")) - -(defun jao-doc-view--imenu-create-index () - (let (index) - (dolist (item (or jao--pdf-outline - (setq jao--pdf-outline - (jao-doc-view-pdf-outline jao-doc-view--imenu-file)))) - (let-alist item - (let* ((lvl (make-string (max 0 (1- .level)) ?.)) - (title (format "%s%s (%s)" lvl .title .page))) - (push `(,title 0 jao-doc-view--go ,item) index)))) - (nreverse index))) - -(defun jao-doc-view--go (&rest args) - (when-let (item (car (last args))) - (let-alist item (funcall jao-doc-view--goer .page)))) - -(add-hook 'doc-view-mode-hook #'jao-doc-view--enable-imenu) - - +(defun jao-doc-view-enable-imenu (file-name goto-page) + (let ((ifun (lambda () (doc-view-imenu-index file-name goto-page))) + (doc-view-imenu-enabled t)) + (doc-view-imenu-setup) + (setq-local imenu-create-index-function ifun))) + ;;; Page trailing (defvar-local jao-doc-view--trail-back ()) (defvar-local jao-doc-view--trail-fwd ()) @@ -199,38 +69,55 @@ (advice-add 'doc-view-goto-page :before #'jao-doc-view--trail-push) - +;;; Extract text +(defun jao-doc-view-page-text (&optional re-render no-select) + (interactive "P") + (let* ((pno (doc-view-current-page)) + (in buffer-file-name) + (cdir (or (doc-view--current-cache-dir) "/tmp")) + (out (format "%s/p%s.txt" cdir pno))) + (when (and (file-exists-p out) re-render) + (delete-file out)) + (unless (file-exists-p out) + (shell-command-to-string (format "mutool convert -o %s %s %s" out in pno))) + (if no-select + out + (find-file out) + (view-mode)))) + +(define-key doc-view-mode-map "t" #'jao-doc-view-page-text) + ;;; Find URLs -(defun jao-doc-view--page-urls (all) - (if doc-view--current-converter-processes - (message "DocView: please wait till conversion finished.") - (let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir))) - (page (doc-view-current-page)) - (pd-rx (rx (+ (literal page-delimiter)))) - (urls)) - (if (file-readable-p txt) - (with-current-buffer (find-file-noselect txt) - (goto-char (point-min)) - (unless all (re-search-forward pd-rx nil t (1- page))) - (let ((end (save-excursion - (if (and (not all) (re-search-forward pd-rx nil t)) - (point) - (point-max))))) - (while (re-search-forward "https?://" end t) - (push (thing-at-point-url-at-point) urls)) - urls)) - (doc-view-doc->txt txt (lambda () (jao-doc-view--page-urls all))) - 'wait)))) +(defun jao-doc-view--full-txt () + (expand-file-name "doc.txt" (doc-view--current-cache-dir))) + +(defun jao-doc-view--collect-urls (file) + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (let ((urls nil)) + (while (re-search-forward "https?://" nil t) + (push (thing-at-point-url-at-point) urls)) + urls))) + +(defun jao-doc-view--page-urls (&optional all) + (let ((txt (jao-doc-view--full-txt))) + (cond ((and all (not (file-exists-p txt))) + (message "Full text not extracted yet: doing so!") + (doc-view-doc->txt txt (lambda () (message "Text extracted"))) + 'wait) + (all (jao-doc-view--collect-urls txt)) + (t (jao-doc-view--collect-urls (jao-doc-view-page-text nil t)))))) (defun jao-doc-view-visit-url (all) "Visit URL displayed in this page." - (interactive "P" doc-view-mode) + (interactive "P") (let ((urls (jao-doc-view--page-urls all))) (cond ((eq 'wait urls) (message "Extracting text, please wait and retry.")) - ((zerop (length urls)) (message "No URLs in this page")) + ((zerop (length urls)) + (message "No URLs in this %s" (if all "document" "page"))) (t (when-let (url (completing-read "URL: " urls nil nil (when (null (cdr urls)) (car urls)))) (browse-url url)))))) - +;;; . (provide 'jao-doc-view) diff --git a/lib/doc/jao-org-links.el b/lib/doc/jao-org-links.el index 9102927..88c0561 100644 --- a/lib/doc/jao-org-links.el +++ b/lib/doc/jao-org-links.el @@ -1,21 +1,20 @@ ;; -*- lexical-binding: t; -*- -(require 'pdf-tools nil t) - (require 'jao-org-notes) (require 'jao-doc-view) - -(declare pdf-info-outline "pdf-info") +(require 'jao-doc-session) +(require 'jao-pdf) (defvar jao-org--sink-dir "./") -(defvar jao-org-open-pdf-fun #'jao-org--pdf-tools-open) +(defvar jao-org-open-pdf-fun #'jao-org--default-open) -(defun jao-org--pdf-tools-open (path page &optional height) +(defun jao-org--default-open (path page &optional height) (org-open-file path 1) (jao-doc-view-goto-page page height)) (defun jao-org--pdf-open (path page &optional height) - (funcall (or jao-org-open-pdf-fun #'jao-org--pdf-tools-open) path page height)) + (when (file-exists-p path) (jao-doc-session-mark path)) + (funcall (or jao-org-open-pdf-fun #'jao-org--default-open) path page height)) (defun jao-org-links--open-pdf (link) "Open LINK in pdf-view-mode." @@ -39,7 +38,7 @@ (read-file-name "Import file: " jao-org--sink-dir link link)))) (rename-file real-file dest-path))) - (if (jao-doc-view-is-pdf dest-path) + (if (jao-pdf-is-pdf-file dest-path) (jao-org-links--open-pdf full-link) (browse-url (format "file://%s" (expand-file-name dest-path)))))) @@ -47,7 +46,7 @@ (let ((default-directory jao-org--sink-dir)) (let ((f (replace-regexp-in-string "^file:" "doc:" (org-file-complete-link arg)))) - (if (jao-doc-view-is-pdf f) + (if (jao-pdf-is-pdf-file f) (let ((page (read-from-minibuffer "Page: " ""))) (if (> (string-to-number page) 0) (concat f "::" (read-from-minibuffer "Page: " "")) @@ -63,7 +62,7 @@ (when (derived-mode-p 'pdf-view-mode 'doc-view-mode) (jao-org-links-store-pdf-link buffer-file-name (jao-doc-view-current-page) - (jao-doc-view-section-title))))) + (jao-pdf-section-title))))) ;;;###autoload (defun jao-org-links-store-pdf-link (path page title) @@ -75,29 +74,28 @@ ;;;###autoload (defun jao-org-insert-doc (title) (interactive "sDocument title: ") - (insert (format "[[doc:%s][%s]]" (jao-doc-view-title->file title) title))) + (insert (format "[[doc:%s][%s]]" (jao-pdf-title-to-file-name title) title))) ;;;###autoload -(defun jao-org-org-to-pdf-file () - (expand-file-name (concat "doc/" (file-name-base buffer-file-name) ".pdf") - (file-name-directory jao-org-notes-dir))) - -;;;###autoload -(defun jao-org-pdf-to-org-file (&optional file-name) - (let* ((file-name (or file-name buffer-file-name)) - (bn (file-name-base file-name)) - (rx (format "%s\\.org$" (regexp-quote bn)))) - (save-some-buffers nil - (lambda () - (string-prefix-p jao-org-notes-dir buffer-file-name))) - (or (car (directory-files-recursively jao-org-notes-dir rx)) - (let* ((dirs (jao-org-notes-cats)) - (dir (completing-read "Notes subdir: " dirs nil t))) - (expand-file-name (concat dir "/" bn ".org") jao-org-notes-dir))))) +(defun jao-org-open-from-zathura (title &optional no-ask) + (when-let* ((info (jao-pdf-zathura-file-info title)) + (pdf-file (car info)) + (page (cadr info)) + (file (jao-org-notes-find-for-pdf pdf-file))) + (jao-afio-goto-docs) + (let ((exists (file-exists-p file))) + (find-file file) + (unless exists (jao-org-insert-doc-skeleton)) + (let ((lnk (jao-pdf--zathura-link info))) + (jao-doc-session-mark) + (if (or (not exists) (and (not no-ask) (y-or-n-p "Insert link?"))) + (insert lnk "\n") + (kill-new lnk) + (message "Link to %s (%s) killed" file page)))))) ;;;###autoload (defun jao-org-insert-doc-skeleton (&optional title) - (insert "#+title: " (or title (jao-doc-view-title (buffer-file-name))) + (insert "#+title: " (or title (jao-pdf-title (buffer-file-name))) "\n#+author:\n#+filetags: ") (jao-org-notes-insert-tags) (insert "\n#+startup: latexpreview\n\n")) @@ -105,10 +103,10 @@ ;;;###autoload (defun jao-org-pdf-goto-org (arg) (interactive "P") - (when (jao-doc-view-is-pdf buffer-file-name) - (let* ((file (jao-org-pdf-to-org-file)) + (when (jao-pdf-is-pdf-file buffer-file-name) + (let* ((file (jao-org-notes-find-for-pdf)) (new (not (file-exists-p file))) - (title (jao-doc-view-title))) + (title (jao-pdf-title))) (when (or arg new) (org-store-link nil t)) (find-file-other-window file) (when new @@ -119,12 +117,15 @@ (defun jao-org-pdf-goto-org* () (interactive) (jao-org-pdf-goto-org t)) ;;;###autoload -(defun jao-org-org-goto-pdf () +(defun jao-org-goto-pdf () (interactive) (if-let (f (jao-org-org-to-pdf-file)) - (find-file-other-window f) + (jao-org--pdf-open f nil) (user-error "No PDF file associated with this buffer"))) +(with-eval-after-load "org" + (define-key org-mode-map (kbd "C-c o") #'jao-org-goto-pdf)) + ;;;###autoload (defun jao-org-links-setup (sink-dir) (interactive) @@ -133,7 +134,6 @@ :complete #'jao-org-links--complete-doc :store #'jao-org-links--store-pdf-link) (org-link-set-parameters "docview" :store #'ignore) - (org-link-set-parameters "message" :follow #'jao-org-links-open-mail) (setq jao-org--sink-dir (file-name-as-directory sink-dir))) (provide 'jao-org-links) diff --git a/lib/doc/jao-org-notes.el b/lib/doc/jao-org-notes.el index 738c938..d3f18b8 100644 --- a/lib/doc/jao-org-notes.el +++ b/lib/doc/jao-org-notes.el @@ -1,6 +1,6 @@ ;;; jao-org-notes.el --- A simple system for org note taking -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022 jao +;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: tools @@ -26,36 +26,65 @@ ;;; Code: (require 'org) (require 'consult) +(require 'jao-shell) (defvar jao-org-notes-dir (expand-file-name "notes" org-directory)) -(defun jao-org-notes--rg (str) +(defun jao-org-notes-list () + (directory-files-recursively jao-org-notes-dir "\\.org$")) + +(defun jao-org-notes--rg-cmd (rgx &rest args) `("rg" "--null" "--line-buffered" "--color=never" "--max-columns=250" - "--no-heading" "--line-number" "--smart-case" "." "-e" - ,(format "^(#.(title|filetags): .*)%s" str))) + "--type=org" "--line-number" "--no-heading" "--smart-case" + ,@args ,default-directory "-e" ,rgx)) + +(defun jao-org-notes--rg-title-or-tags (str) + (let* ((m (string-match "^\\([^/]+\\)/\\(.*\\)" str)) + (d (or (and m (match-string 1 str)) "")) + (str (if m (match-string 2 str) str)) + (default-directory + (if (file-directory-p d) (expand-file-name d) default-directory)) + (ts (mapconcat #'identity (split-string str "[:,]+" t) ":|")) + (rgx (format "^#.(title: .*%s|(tags:.*(%s:)))" str ts))) + (jao-org-notes--rg-cmd rgx "-m" "2"))) (defun jao-org-notes--clean-match (m) - (cons (format "%s %s" - (replace-regexp-in-string "^\\./" "" (car m)) - (replace-regexp-in-string "[0-9]+:#\\+\\(file\\)?\\(title\\|tags\\):" - " (\\2)" (cadr m))) - (expand-file-name (car m) default-directory))) + (list (format "%s %s" + (replace-regexp-in-string default-directory "" (car m) nil t) + (replace-regexp-in-string "[0-9]+:#\\+\\(title\\|tags\\):" + "" (cadr m))) + (expand-file-name (car m) default-directory) + (string-to-number (cadr m)))) (defun jao-org-notes--matches (lines) (mapcar (lambda (l) (jao-org-notes--clean-match (split-string l "\0" t))) lines)) +(defun jao-org-notes--grep-rx (rx &rest rg-args) + (let ((default-directory jao-org-notes-dir)) + (jao-org-notes--matches + (apply #'jao-shell-cmd-lines (apply #'jao-org-notes--rg-cmd rx rg-args))))) + (defvar jao-org-notes--grep-history nil) -(defun jao-org--grep (prompt &optional cat no-req) +(defun jao-org-notes--consult-group (m transform) + (or (and transform m) + (and (string-match-p "^[^:]+ + :" m) "tags") + "titles")) + +(defun jao-org-notes--consult-rg (prompt &optional cat no-req cmd initial) (let ((default-directory (expand-file-name (or cat "") jao-org-notes-dir))) (consult--read - (consult--async-command #'jao-org-notes--rg - (consult--async-transform jao-org-notes--matches)) + (consult--async-pipeline + (consult--process-collection #'jao-org-notes--rg-title-or-tags) + (consult--async-transform #'jao-org-notes--matches)) :prompt prompt - :initial (consult--async-split-initial "") - :add-history (concat (consult--async-split-initial (thing-at-point 'symbol))) + :initial (or initial "") + :add-history (thing-at-point 'symbol) :require-match (not no-req) :category 'jao-org-notes-lookup + :group 'jao-org-notes--consult-group + :lookup (lambda (cand cands &rest _) + (or (cadr (assoc cand cands)) (substring cand 1))) :history '(:input jao-org-notes--grep-history)))) (defun jao-org-notes-cats () @@ -64,15 +93,16 @@ (defun jao-org-notes--cat () (let* ((cat (completing-read "Top level category: " (jao-org-notes-cats)))) (cond ((file-exists-p (expand-file-name cat jao-org-notes-dir)) cat) - ((yes-or-no-p "New category, create?") cat) - (t (jao-roam--cat))))) + ((yes-or-no-p "New category, create?") cat)))) -(defun jao-org-notes--insert-title () +(defun jao-org-notes--insert-title (&optional title) (let* ((cat (jao-org-notes--cat)) - (title (file-name-base (jao-org--grep "Title: " cat t))) + (note (jao-org-notes--consult-rg "Title: " cat t nil title)) + (title (file-name-base note)) (title (replace-regexp-in-string "^#" "" title))) (when (not (string-empty-p title)) (let* ((base (replace-regexp-in-string " +" "-" (downcase title))) + (base (replace-regexp-in-string "[^-[:alnum:][:digit:]]" "" base)) (fname (expand-file-name (concat cat "/" base ".org") jao-org-notes-dir)) (exists? (file-exists-p fname))) @@ -81,85 +111,88 @@ (insert "#+title: " title "\n") t))))) -(defvar jao-org-notes--tags nil) -(defvar jao-org-notes-tags-cache-file "~/.emacs.d/cache/tags.eld") - -(defun jao-org-notes--save-tags () - (with-current-buffer (find-file-noselect jao-org-notes-tags-cache-file) - (delete-region (point-min) (point-max)) - (print jao-org-notes--tags (current-buffer)) - (let ((message-log-max nil) - (inhibit-message t)) - (save-buffer)))) +(defun jao-org-notes--find-tag (tag) + (jao-org-notes--grep-rx (format "^#.tags:.*:%s:" tag) "-m" "1")) -(defun jao-org-notes--read-tags-cache () - (let ((b (find-file-noselect jao-org-notes-tags-cache-file))) - (with-current-buffer b (goto-char (point-min))) - (setq jao-org-notes--tags (read b)))) +(defvar jao-org-notes--tags nil) +(defvar jao-org-notes--tag-history nil) (defun jao-org-notes--read-tags () - (unless jao-org-notes--tags (jao-org-notes--read-tags-cache)) - (let* ((tags (completing-read-multiple "Tags: " jao-org-notes--tags)) - (new-tags (seq-difference tags jao-org-notes--tags))) - (when new-tags - (setq jao-org--notes-tags - (sort (append new-tags jao-org-notes--tags) #'string<)) - (jao-org-notes--save-tags)) + (let* ((tags (completing-read-multiple "Tags: " jao-org-notes--tags nil nil nil + 'jao-org-notes--tag-history))) + (setq jao-org-notes--tags (seq-union jao-org-notes--tags tags #'string=)) tags)) -(defun jao-org-notes--insert-tags () - (insert "#+filetags: " (mapconcat #'identity (jao-org-notes--read-tags) " ") "\n")) - -(defun jao-org-notes--insert-date () - (insert "#+date: ") - (org-insert-time-stamp (current-time)) - (insert "\n")) - (defun jao-org-notes--template (k) - `(,k "Note" plain (file jao-org-notes-open-or-create) - "\n- %a\n %i" - :jump-to-captured t)) + `(,k "Note" plain (file jao-org-notes-create) + "%(if %:url \"#+link: %:url\" \"\")\n\n- %a\n %i")) + +(defun jao-org-notes-all-tags () + (let ((tags nil)) + (dolist (m (jao-org-notes--find-tag ".*")) + (setq tags (seq-union tags (cdr (split-string (car m) ":" t))))) + (sort tags #'string<))) + +(defun jao-org-notes-find-for-pdf (&optional file-name) + "Given a PDF file name, find its org notes counterpart." + (let* ((file-name (or file-name buffer-file-name)) + (bn (file-name-base file-name)) + (rx (format "%s\\.org$" (regexp-quote bn))) + (pred (lambda () (string-prefix-p jao-org-notes-dir buffer-file-name)))) + (save-some-buffers nil pred) + (or (car (directory-files-recursively jao-org-notes-dir rx)) + (let* ((d (completing-read "Notes subdir: " (jao-org-notes-cats) nil t)) + (d (file-name-as-directory d))) + (expand-file-name (concat d bn ".org") jao-org-notes-dir))))) -;;;###autoload (defun jao-org-notes-open () "Search for a note file, matching tags and titles with completion." (interactive) - (when-let (f (jao-org--grep "Search notes: ")) + (when-let (f (jao-org-notes--consult-rg "Search notes: ")) (find-file f))) -;;;###autoload -(defun jao-org-notes-open-or-create () - "Open or create a new note file, matching tags and titles with completion." +(defun jao-org-notes-consult-tags () + "Search for a note file, matching all tags with completion." (interactive) - (when (jao-org-notes--insert-title) - (jao-org-notes--insert-date) - (jao-org-notes--insert-tags)) - (save-buffer) - (buffer-file-name)) + (let* ((tags (jao-org-notes--read-tags)) + (init (concat "^..tags: " (mapconcat #'identity tags " ")))) + (consult-ripgrep jao-org-notes-dir init))) -;;;###autoload -(defun jao-org-notes-grep (&optional initial) - "Perform a grep search on all org notes body, via consult-ripgrep." +(defun jao-org-notes-consult-ripgrep (&optional initial cat) (interactive) - (consult-ripgrep jao-org-notes-dir initial)) + (consult-ripgrep (expand-file-name (or cat "") jao-org-notes-dir) initial)) + +(defun jao-org-notes-create (&optional title) + "Create a new note file, matching tags and titles with completion." + (interactive) + (when (jao-org-notes--insert-title title) + (org-insert-time-stamp (current-time) t t "#+date: " "\n") + (insert "#+tags: :" + (mapconcat #'identity (jao-org-notes--read-tags) ":") + ":\n")) + (save-buffer) + (current-buffer)) -;;;###autoload (defun jao-org-notes-backlinks () "Show a list of note files linking to the current one." (interactive) - (jao-org-notes-search (concat "\\[\\[file:\\(.*/\\)?" (buffer-name)))) + (if-let* ((res (jao-org-notes--grep-rx + (concat "\\[file:.*" (regexp-quote (buffer-name)) "\\]\\["))) + (file (completing-read "File: " res nil t nil)) + (entry (assoc file res))) + (progn (find-file (cadr entry)) + (when-let (line (caddr entry)) (goto-line line))) + (message "Nobody links here!"))) -;;;###autoload (defun jao-org-notes-insert-tags () "Insert a list of tags at point, with completing read." (interactive) - (insert (mapconcat 'identity (jao-org-notes--read-tags) " "))) + (insert ":" (mapconcat 'identity (jao-org-notes--read-tags) ":") ":")) -;;;###autoload (defun jao-org-notes-insert-link () "Select a note file (with completion) and insert a link to it." (interactive) - (when-let (f (jao-org--grep "Notes file: ")) + (when-let (f (jao-org-notes--consult-rg "Notes file: ")) (let ((rel-path (file-relative-name f default-directory)) (title (with-current-buffer (find-file-noselect f) (save-excursion @@ -168,11 +201,19 @@ (match-string 1)))))) (insert (format "[[file:%s][%s]]" rel-path title))))) +(defun jao-org-notes-stats () + (interactive) + (message "%d notes, %d tags in %s" + (length (jao-org-notes-list)) + (length jao-org--notes-tags) + jao-org-notes-dir)) + ;;;###autoload (defun jao-org-notes-setup (mnemonic) "Set up the notes system, providing a mnemonic character for its org template." (setq org-capture-templates - (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic))) + (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic)) + jao-org-notes--tags (jao-org-notes-all-tags)) (when (fboundp 'org-capture-upgrade-templates) (org-capture-upgrade-templates org-capture-templates))) diff --git a/lib/doc/jao-pdf.el b/lib/doc/jao-pdf.el new file mode 100644 index 0000000..1ee74bc --- /dev/null +++ b/lib/doc/jao-pdf.el @@ -0,0 +1,100 @@ +;;; jao-pdf.el --- utilities for pdf files -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 jao + +;; Author: jao <mail@jao.io> +;; Keywords: docs + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Some niceties for PDFs: +;; +;; - Using mutools, we can extract the outline of PDFs, and tell back the +;; section title of a given page. +;; - Interoperability with zathura. + +(require 'jao-doc-session) + +;;; PDF info + +(declare-function 'pdf-info-outline "pdf-info") + +(defvar-local jao-pdf--outline nil) + +(defun jao-pdf-is-pdf-file (file) + "Simply checks the FILE extension." + (string-match-p ".*\\.pdf$" file)) + +(defun jao-pdf-title-to-file-name (title) + "Convert a title, possibly with embedded spaces, to a PDF filename." + (concat (mapconcat 'downcase (split-string title nil t) "-") ".pdf")) + +(defun jao-pdf-title (&optional fname) + (if (or fname (not (derived-mode-p 'doc-view-mode 'pdf-view-mode))) + (let ((base (file-name-base (or fname (buffer-file-name))))) + (capitalize (replace-regexp-in-string "-" " " base))) + (or (jao-pdf-section-title) + (when buffer-file-name (jao-pdf-title buffer-file-name))))) + +(defvar-local jao-pdf--outline nil) + +(defun jao-pdf-section-title (&optional page file-name) + (when (not jao-pdf--outline) + (setq-local jao-pdf--outline (doc-view--pdf-outline file-name))) + (let ((page (or page + (and (derived-mode-p 'doc-view-mode) (doc-view-current-page)) + (and (derived-mode-p 'pdf-view) (pdf-view-current-page)))) + (outline jao-pdf--outline) + (cur-page 0) + (cur-title (jao-pdf-title (or file-name buffer-file-name "title")))) + (while (and (car outline) page (< cur-page page)) + (setq cur-page (cdr (assoc 'page (car outline)))) + (when (<= cur-page page) + (setq cur-title (cdr (assoc 'title (car outline))))) + (setq outline (cdr outline))) + (replace-regexp-in-string "[[:blank:]]+" " " cur-title))) + +;;; zathura interop +(defun jao-pdf-zathura-open-cmd (file page &optional suffix) + (let ((page (if page (format "-P %s" page) ""))) + (format "zathura %s %s %s" file page (or suffix "")))) + +(defun jao-pdf-zathura-title-rx (file) + (concat (file-name-nondirectory file) " \\[.+\\]")) + +;; e.g. "~/org/doc/write-yourself-a-scheme-in-48-hours.pdf [96 (96/138)]" +(defun jao-pdf-zathura-file-info (title) + (when (string-match "\\(.+\\) \\[\\(.+\\) (\\([0-9]+\\)/\\([0-9]+\\))\\]" + title) + (list (expand-file-name (match-string 1 title)) + (string-to-number (match-string 3 title)) + (string-to-number (match-string 4 title)) + (match-string 2 title)))) + +(defun jao-pdf--zathura-link (info) + (when-let* ((file (car info)) + (page (cadr info)) + (no (or (car (last info)) page)) + (fn (file-name-nondirectory file)) + (lnk (format "doc:%s::%s" fn page)) + (desc (format "%s (p. %s)" (jao-pdf-section-title page file) no))) + (org-make-link-string lnk desc))) + +(defun jao-pdf-zathura-org-link (title) + (jao-pdf--zathura-link (jao-pdf-zathura-file-info title))) + +(provide 'jao-pdf) +;;; jao-pdf.el ends here diff --git a/lib/eos/jao-afio.el b/lib/eos/jao-afio.el index 306a1d5..10e9115 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 jao ;; Author: jao <mail@jao.io> ;; Keywords: frames @@ -18,66 +18,63 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. -;;; Code: - +;;; initialisation (require 'cl-lib) +(require 'jao-doc-session) + +(defvar jao-afio-use-frames (not window-system)) (defvar jao-open-doc-fun 'find-file) (defvar jao-afio-mail-function 'gnus) (defvar jao-afio-use-w3m nil) -(defvar jao-afio-notmuch-in-web nil) +(defvar jao-afio-auto-toggle nil) (defvar jao-afio-switch-hook nil) -(defvar jao-afio--configs '(?c ?w ?g ?p ?s)) -(defvar jao-afio--current-config (car jao-afio--configs)) -(defvar jao-afio--locker nil) -(defvar jao-afio-fallback-fun nil) +(defvar jao-afio--configs '(?c ?w ?g ?p ?s ?t)) +(defvar jao-afio--previous-config (car jao-afio--configs)) -(defun jao-afio--check-frame-p () - (assoc 'afio (frame-parameters))) +(defun jao-afio--current-config (&optional c f) + (when c (modify-frame-parameters f `((afio . ,c)))) + (frame-parameter f 'afio)) (defun jao-afio--init (&optional f) (interactive) - (when (and (frame-live-p jao-afio--locker) - (not (eql f jao-afio--locker))) - (if jao-afio-fallback-fun - (funcall jao-afio-fallback-fun) - (error "Another frame is using afio"))) - (setq jao-afio--locker f) - (modify-frame-parameters f '((afio . t))) - (setq jao-afio--current-config ?c) - (mapc (lambda (r) (set-register r nil)) jao-afio--configs) - (window-configuration-to-register ?c)) - -(defun jao-afio--steal () - (interactive) - (setq jao-afio--locker nil) - (jao-afio--init (window-frame (get-buffer-window (current-buffer))))) + (jao-afio--current-config ?c) + (if jao-afio-use-frames + (set-frame-name "W1") + (window-configuration-to-register ?c))) (defun jao-afio--check-frame () - (unless (jao-afio--check-frame-p) - (or ;; (when jao-afio-fallback-fun - ;; (funcall jao-afio-fallback-fun) - ;; t) - (when (y-or-n-p "Another frame is using afio. Steal? ") - (jao-afio--steal) - t) - (error "Aborted")))) - -(defun jao-afio--next-frame () - (interactive) - (jao-afio--check-frame) - (let* ((cur (member jao-afio--current-config jao-afio--configs)) - (next (or (cadr cur) (car jao-afio--configs)))) - (jao-afio--goto-frame next))) + (unless (jao-afio--current-config) + (jao-afio--init (window-frame (get-buffer-window (current-buffer)))))) +;;; utilities +(defun jao-afio-trisect (&optional force) + (interactive) + (let ((fw (frame-width)) + (display-buffer-alist nil)) + (cond ((or force (>= fw 240)) + (let ((b (current-buffer))) + (delete-other-windows) + (switch-to-buffer (other-buffer b)) + (split-window-horizontally) + (switch-to-buffer (other-buffer b)) + (split-window-horizontally) + (switch-to-buffer b) + (balance-windows))) + ((> fw 162) + (delete-other-windows) + (split-window-horizontally) + (switch-to-buffer (other-buffer)))))) + +;;; session openers ;;;###autoload -(defun jao-afio-open-pdf-session () +(defun jao-afio-open-pdf-session (&optional docs) (interactive) - (let ((jao-doc-view-inhibit-session-save t)) - (dolist (doc (jao-doc-view-session)) - (when (and (file-exists-p doc) (y-or-n-p (format "Open %s? " doc))) - (jao-open-doc doc) + (let ((jao-doc-session-inhibit-save t)) + (dolist (doc (or docs (jao-doc-session))) + (when (and doc (file-exists-p doc)) + (if (jao-pdf-is-pdf-file doc) (jao-open-doc doc) (find-file doc)) (other-window 1))) (other-window 1))) @@ -85,43 +82,48 @@ (interactive) (delete-other-windows) (split-window-right) - (let ((docs (cl-remove-if-not (lambda (b) - (with-current-buffer b (jao-doc-view--is-doc))) - (buffer-list)))) + (let ((docs (cl-remove-if-not 'jao-doc-session-is-doc (buffer-list)))) (if (car docs) (progn (switch-to-buffer (car docs)) (switch-to-buffer-other-window (or (cadr docs) (car docs)))) - (when (and (jao-doc-view-session) (y-or-n-p "Load saved session? ")) - (jao-afio-open-pdf-session))))) + (when-let (docs (jao-doc-session)) + (when (y-or-n-p (format "Load saved session? (%d docs)" (length docs))) + (jao-afio-open-pdf-session docs)))))) + +(declare-function w3m "w3m") +(declare-function notmuch "notmuch") +(declare-function jao-eww-session-eww-buffers "jao-eww-session") +(declare-function jao-eww-session-load "jao-eww-session") -(declare w3m "w3m") -(declare w3m-alive-p "w3m") -(declare w3m-previous-buffer "w3m") -(declare notmuch "notmuch") +(defun jao-afio--open-eww-session () + (if-let (b (jao-eww-session-eww-buffers)) + (switch-to-buffer (car b)) + (jao-eww-session-load))) ;;;###autoload (defun jao-afio-open-www () (interactive) (require 'jao-eww-session) (if (< (frame-width) 160) - (if jao-afio-use-w3m (w3m) (jao-eww-session-load)) - (delete-other-windows) - (split-window-right) + (if jao-afio-use-w3m (w3m) (jao-afio--open-eww-session)) (if jao-afio-use-w3m - (w3m) - (jao-eww-session-load) + (progn (delete-other-windows) + (split-window-right) + (w3m)) + (jao-afio-trisect) + (jao-afio--open-eww-session) (let ((b (current-buffer))) (other-window 1) - (if jao-afio-notmuch-in-web - (notmuch) - (switch-to-buffer (car (jao-eww-session--list-buffers b)))) + (switch-to-buffer (car (jao-eww-session-eww-buffers b))) + (other-window 1) + (switch-to-buffer (car (jao-eww-session-eww-buffers b))) (other-window 1))))) ;;;###autoload (defun jao-afio-open-gnus () (interactive) (delete-other-windows) - (org-agenda-list) + (jao-org-agenda) (calendar) (find-file (expand-file-name "inbox.org" org-directory)) (gnus) @@ -131,136 +133,130 @@ (other-window 1) (delete-other-windows-vertically) (find-file (expand-file-name "inbox.org" org-directory)) + (set-window-dedicated-p nil t) (split-window-below (/ (window-height) 3)) (other-window 1) - (org-agenda-list) - (split-window-below -9) + (jao-org-agenda) + (set-window-dedicated-p nil t) + (split-window-below -8) (other-window 1) (switch-to-buffer "*Calendar*") + (set-window-dedicated-p nil t) (other-window 1)) -;;;###autoload -(defun jao-afio-open-notmuch () - (interactive) +(defun jao-afio--open-mail (fun) + (unless (get-buffer "*Calendar*") (calendar)) (delete-other-windows) (split-window-horizontally -80) - (notmuch) - (jao-afio--mail-sidebar)) - -(defun jao-afio-open-mail-function () - (interactive) - (jao-trisect) - (other-window 2) - (delete-window) - (other-window 1) - (funcall jao-afio-mail-function) + (funcall fun) + ;; (set-window-dedicated-p nil t) (jao-afio--mail-sidebar)) ;;;###autoload (defun jao-afio-open-mail () (interactive) - (unless (get-buffer "*Calendar*") (calendar)) (cond ((eq 'gnus jao-afio-mail-function) (jao-afio-open-gnus)) - ((eq 'notmuch jao-afio-mail-function) (jao-afio-open-notmuch)) - (jao-afio-open-mail-function (jao-afio-open-mail-function)))) + ((eq 'notmuch jao-afio-mail-function) (jao-afio--open-mail 'notmuch)) + (t (jao-afio-trisect)))) + +;;;###autoload +(defun jao-afio-reset () + (interactive) + (delete-other-windows) + (cl-case (jao-afio--current-config) + (?w (jao-afio-open-www)) + (?g (jao-afio-open-mail)) + (?p (jao-afio-open-doc)) + (t (jao-afio-trisect)))) + +;;; go to frame +(defsubst jao-afio--find-frame (c) + (seq-find (lambda (f) (eq (jao-afio--current-config nil f) c)) (frame-list))) + +(defun jao-afio-frame-name (&optional c) + (alist-get (or c (jao-afio--current-config)) + '((?c . "main") (?s . "scratch") (?g . "mail") + (?p . "docs") (?w . "web") (?t . "chats")))) + +(defun jao-afio-frame-no (&optional c) + (alist-get (or c (jao-afio--current-config)) + '((?s . 0) (?c . 1) (?g . 2) (?w . 3) (?p . 4) (?t . 5)))) (defun jao-afio--goto-frame (next &optional reset) - (when (or reset (not (eq next jao-afio--current-config))) - (let ((next-cfg (when (not reset) (get-register next)))) - (window-configuration-to-register jao-afio--current-config) - (setq jao-afio--current-config next) - (if next-cfg - (jump-to-register next) - (delete-other-windows) - (cl-case next - (?w (jao-afio-open-www)) - (?g (jao-afio-open-mail)) - (?p (jao-afio-open-doc)) - (?s (delete-other-windows)))) - (run-hooks 'jao-afio-switch-hook)))) - -(defun jao-afio--goto-main (&optional reset) - (interactive "P") (jao-afio--check-frame) - (jao-afio--goto-frame ?c reset)) - -(defun jao-afio--goto-scratch (&optional reset) + (let ((current (jao-afio--current-config))) + (if (and jao-afio-auto-toggle + (eq next current) + (not reset) + (not (eq current jao-afio--previous-config))) + (jao-afio--goto-frame jao-afio--previous-config) + (when (or reset (not (eq next current))) + (if jao-afio-use-frames + (let ((f (jao-afio--find-frame next))) + (select-frame-set-input-focus (or f (make-frame))) + (when (setq reset (or reset (not f))) + (set-frame-name + (format "W%s" (or (jao-afio-frame-no next) next))))) + (window-configuration-to-register (jao-afio--current-config)) + (when (and (not reset) (get-register next)) + (ignore-errors (jump-to-register next))) + (setq reset (or reset (not (get-register next))))) + (jao-afio--current-config next) + (unless (eq current next) (setq jao-afio--previous-config current)) + (when reset (jao-afio-reset)) + (run-hooks 'jao-afio-switch-hook))))) + +(defun jao-afio-goto-main (&optional reset) (interactive "P") - (jao-afio--check-frame) - (jao-afio--goto-frame ?s reset)) + (jao-afio--goto-frame ?c reset)) -(defun jao-afio--goto-mail (&optional reset) +(defun jao-afio-goto-mail (&optional reset) (interactive "P") - (jao-afio--check-frame) (jao-afio--goto-frame ?g reset)) -(defun jao-afio--goto-docs (&optional reset) +(defun jao-afio-goto-docs (&optional reset) (interactive "P") - (jao-afio--check-frame) (jao-afio--goto-frame ?p reset)) -(defun jao-afio--goto-www (&optional reset) +(defun jao-afio-goto-www (&optional reset) (interactive "P") - (if (jao-afio--check-frame-p) - (jao-afio--goto-frame ?w reset) - (when (and jao-afio-use-w3m (w3m-alive-p)) - (pop-to-buffer (w3m-alive-p))))) - -(defun jao-afio--try-init (&optional f) - (ignore-errors (jao-afio--init f)) - t) - -(defun jao-afio--goto-www-buffer (buf &rest _) - (jao-afio--goto-www) - (jao-first-window) - (switch-to-buffer buf nil t)) - -(defun jao-afio--goto-pdf-buffer (buf &rest _) - (if (jao-afio--check-frame-p) - (progn (jao-afio--goto-docs) - (jao-first-window) - (switch-to-buffer buf nil t)) - (pop-to-buffer buf))) + (jao-afio--goto-frame ?w reset)) + +(defun jao-afio-toggle () + (interactive) + (jao-afio--goto-frame jao-afio--previous-config)) (defun jao-afio-goto-scratch (&optional one-win) - (jao-afio--goto-scratch) + (interactive "P") + (jao-afio--goto-frame ?s 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-dirmon.el b/lib/eos/jao-dirmon.el index 4fb8609..117da85 100644 --- a/lib/eos/jao-dirmon.el +++ b/lib/eos/jao-dirmon.el @@ -1,6 +1,6 @@ ;;; jao-dirmon.el --- little utility to monitor disk usage -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2024, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: tools @@ -25,6 +25,7 @@ ;;; Code: (require 'multisession) +(require 'view) (require 'jao-shell) (define-multisession-variable jao-dirmon-last '()) @@ -34,12 +35,32 @@ (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-disable) + (delete-region (point-min) (point-max)) + (insert "High deltas since " (car old) "\n\n") + (dolist (d (seq-sort-by #'cdr #'> deltas)) + (insert (format "- %s: %s Mb\n" (car d) (cdr d)))) + (insert "\n\nSizeable dirs\n\n") + (let ((threshold (* 10 jao-dirmon-threshold))) + (dolist (c (seq-take-while (lambda (x) (> (cdr x) threshold)) + (seq-sort-by #'cdr #'> current))) + (insert (format "- %s: %s Mb\n" (car c) (cdr c))))) + (beginning-of-buffer) + (view-mode-enable) + (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 +70,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..54d58f0 100644 --- a/lib/eos/jao-eshell-here.el +++ b/lib/eos/jao-eshell-here.el @@ -1,6 +1,6 @@ ;;; jao-eshell-here.el --- Easy opening of eshell buffers -*- lexical-binding: t; -*- -;; Copyright (C) 2021 jao +;; Copyright (C) 2021, 2023 jao ;; Author: jao <mail@jao.io> ;; Keywords: eshell @@ -64,7 +64,7 @@ C-u) open in the current's buffer default dir." (jao-with-attached-buffer "^\\*eshell" 0.5 (if (buffer-live-p b) (progn (pop-to-buffer b nil t) - (eshell-save-some-history) + ;; (eshell-save-some-history) (when dir (jao-eshell--cd-here dir))) (let ((default-directory (or dir default-directory))) (eshell (when force-new 4))) @@ -75,7 +75,7 @@ C-u) open in the current's buffer default dir." (when (derived-mode-p 'eshell-mode) (when (fboundp 'eshell-autojump-save) (eshell-autojump-save)) - (eshell-save-some-history) + ;; (eshell-save-some-history) (if (> (frame-height) (window-height)) (delete-window) (bury-buffer)))) diff --git a/lib/eos/jao-minibuffer.el b/lib/eos/jao-minibuffer.el index bdafa74..6cd5b24 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 jao ;; Author: jao <mail@jao.io> ;; Keywords: extensions @@ -27,18 +27,20 @@ (defvar jao-minibuffer-info ()) (defvar jao-minibuffer-msg-info '("")) (defvar jao-minibuffer-align-right t) -(defvar jao-minibuffer-right-margin (if window-system 0 2)) +(defvar jao-minibuffer-adaptive-alignment t) +(defvar jao-minibuffer-right-margin (if window-system 0 1)) (defvar jao-minibuffer-maximized-frames-p t) (defvar jao-minibuffer-frame-width nil) (defvar jao-minibuffer-active-buffer-line-color "azure4") (defvar jao-minibuffer-inactive-buffer-line-color "grey25") +(defvar jao-minibuffer-inhibit nil) (defconst jao-minibuffer--name " *Minibuf-0*") (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) @@ -57,19 +59,17 @@ (msg (cond (jao-minibuffer-align-right (string-trim msg)) (t (string-trim-left msg))))) (unless (string-empty-p msg) - (let ((msg (propertize msg :minibuffer-message t)) + (let ((msg (propertize msg 'minibuffer-message t)) (w (- (jao-minibuffer--width) w jao-minibuffer-right-margin))) (if (> w 0) (jao-minibuffer--trim msg w) ""))))) (defun jao-minibuffer--insert (msg) - (let ((hack (derived-mode-p 'pdf-view-mode 'doc-view-mode))) - (with-current-buffer jao-minibuffer--name - (delete-region (point-min) (point-max)) - (insert msg) - (when hack (other-window 1) (other-window -1))))) + (with-current-buffer jao-minibuffer--name + (delete-region (point-min) (point-max)) + (insert msg))) (defun jao-minibuffer--strip-prev (msg) - (if-let ((n (text-property-any 0 (length msg) :minibuffer-message t msg))) + (if-let ((n (text-property-any 0 (length msg) 'minibuffer-message t msg))) (string-trim (substring msg 0 n)) msg)) @@ -78,16 +78,38 @@ (unless (string-blank-p p) (concat p "\n")))) (defun jao-minibuffer--format-msg (msg) - (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n"))) + (let* ((msgs (mapcar #'jao-minibuffer--strip-prev (split-string msg "\n" t))) + (msgs (cl-remove-if (lambda (s) (get-text-property 0 'invisible s)) msgs)) (prefix (jao-minibuffer--prefix msgs)) - (msg (car (last msgs))) + (msg (or (car (last msgs)) "")) (w (string-width msg))) (if jao-minibuffer-align-right (concat prefix msg (jao-minibuffer--aligned w)) (concat prefix (jao-minibuffer--aligned (+ 3 w)) " " msg)))) (defun jao-minibuffer--set-message (msg) - (when jao-minibuffer-mode (jao-minibuffer--format-msg (or msg "")))) + (when jao-minibuffer-mode + (or (and (string= jao-minibuffer--name (or (buffer-name) "")) msg) + jao-minibuffer-inhibit + (let* ((info (and jao-minibuffer-msg-info + (jao-minibuffer--format-info jao-minibuffer-msg-info))) + (info (or (and info msg (propertize info 'face 'jao-themes-dimm)) + info)) + (sep (if msg " - " "")) + (pref (when info + (let ((len (+ (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) + (progn ;; (advice-add 'select-window :after #'jao-minibuffer-refresh) + (advice-add 'select-window :after #'jao-minibuffer--adjust-alignment) (advice-add 'force-mode-line-update :after #'jao-minibuffer-refresh) - (setq clear-message-function #'jao-minibuffer-refresh) + (setq clear-message-function #'jao-minibuffer--clear-message) (jao-minibuffer-refresh)) (advice-remove 'select-window #'jao-minibuffer-refresh) (advice-remove 'force-mode-line-update #'jao-minibuffer-refresh) (setq clear-message-function nil) (jao-minibuffer--insert ""))) -;;;###autoload (defun jao-minibuffer-refresh (&rest _ignore) (interactive) (when jao-minibuffer-mode @@ -133,5 +158,11 @@ (jao-minibuffer--format-info jao-minibuffer-msg-info)))) (jao-minibuffer--insert (jao-minibuffer--format-msg (or msg "")))))) +(defun jao-minibuffer-toggle-adaptive-alignment () + (interactive) + (setq jao-minibuffer-adaptive-alignment + (not jao-minibuffer-adaptive-alignment)) + (jao-minibuffer-refresh)) + (provide 'jao-minibuffer) ;;; jao-minibuffer.el ends here diff --git a/lib/eos/jao-mode-line.el b/lib/eos/jao-mode-line.el index 0fd5a2e..e4f64c0 100644 --- a/lib/eos/jao-mode-line.el +++ b/lib/eos/jao-mode-line.el @@ -48,10 +48,17 @@ (interactive "P") (jao-mode-line--face-height 'mode-line-inactive all)) +(defun jao-mode-line--old-str () + (thread-first (format-mode-line jao-mode-line--old-format) + (substring-no-properties) + (string-trim))) + ;;;###autoload (defun jao-mode-line-echo () (interactive) - (message "%s" (format-mode-line mode-line-format))) + (message "%s" (jao-mode-line--old-str)) + (setq-local header-line-format + (if header-line-format nil jao-mode-line--old-format))) ;;;###autoload (defun jao-mode-line-hide-inactive (frame) @@ -78,8 +85,8 @@ 'gnus-article-mode 'gnus-summary-mode) mode-line-buffer-identification) - ((derived-mode-p 'circe-channel-mode) - (format "%s [%d]" (buffer-name) (length (circe-channel-nicks)))) + ;; ((derived-mode-p 'circe-channel-mode) + ;; (format "%s [%d]" (buffer-name) (length (circe-channel-nicks)))) ((not (null eww-data)) (or (plist-get eww-data :title) "No title")) (t "%b")))) @@ -120,32 +127,49 @@ (if inactive jao-mode-line--inactive-face jao-mode-line--face))) (defun jao-mode-line-adjust-faces () - (let ((bg (frame-parameter nil 'background-color))) + (let ((bg (and (display-graphic-p) (frame-parameter nil 'background-color))) + (ol (and (display-graphic-p) jao-minibuffer-active-buffer-line-color)) + (ul (and (display-graphic-p) jao-minibuffer-inactive-buffer-line-color))) (jao-mode-line--extract-face nil) (jao-mode-line--extract-face t) (set-face-attribute 'mode-line nil :box nil :height 1 :background bg :foreground bg - :overline jao-minibuffer-active-buffer-line-color - :underline jao-minibuffer-inactive-buffer-line-color - :extend t) + :overline ol :underline ul :extend t) (set-face-attribute 'mode-line-inactive nil :box nil :height 1 :background bg :foreground bg ;; :overline bg - :underline jao-minibuffer-inactive-buffer-line-color - :extend t))) + :underline ul :extend t))) -;;;###autoload -(defun jao-mode-line-add-to-minibuffer (&optional order) +(defun jao-mode-line--maybe-refresh () + (when (mode-line-window-selected-p) (jao-minibuffer-refresh))) + +(defconst jao-mode-line--hidden-format + '("" (:eval (jao-mode-line--maybe-refresh)))) + +(defun jao-mode-line--add-to-minibuffer (order msg-p) (interactive) (setq jao-mode-line--old-format mode-line-format) - (setq-default mode-line-format '(" ")) + (setq-default mode-line-format jao-mode-line--hidden-format) (setq-default mode-line-position jao-mode-line--position) (dolist (b (buffer-list)) - (with-current-buffer b (setq-local mode-line-format '(" ")))) - (jao-minibuffer-add-variable 'jao-mode-line--format (or order 90)) + (with-current-buffer b + (setq-local mode-line-format jao-mode-line--hidden-format))) + (if msg-p + (jao-minibuffer-add-msg-variable '(jao-mode-line--old-str) (or order 90)) + (jao-minibuffer-add-variable 'jao-mode-line--format (or order 90))) (jao-mode-line-adjust-faces)) ;;;###autoload +(defun jao-mode-line-add-to-minibuffer-right (&optional order) + (interactive) + (jao-mode-line--add-to-minibuffer order nil)) + +;;;###autoload +(defun jao-mode-line-add-to-minibuffer-left (&optional order) + (interactive) + (jao-mode-line--add-to-minibuffer order t)) + +;;;###autoload (defun jao-mode-line-remove-from-minibuffer () (interactive) (jao-mode-line--revert-face nil) @@ -154,7 +178,8 @@ (dolist (b (buffer-list)) (with-current-buffer b (setq-local mode-line-format jao-mode-line--old-format))) - (jao-minibuffer-remove-variable 'jao-mode-line--format)) + (jao-minibuffer-remove-variable 'jao-mode-line--format) + (jao-minibuffer-remove-variable '(jao-mode-line--old-str))) (provide 'jao-mode-line) diff --git a/lib/eos/jao-notify.el b/lib/eos/jao-notify.el index a3ea474..623b8cc 100644 --- a/lib/eos/jao-notify.el +++ b/lib/eos/jao-notify.el @@ -1,6 +1,6 @@ ;; jao-notify.el -- Interacting with notification daemon -;; Copyright (c) 2017, 2019, 2020, 2021 Jose Antonio Ortega Ruiz +;; Copyright (c) 2017, 2019, 2020, 2021, 2024 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sun Jan 08, 2017 20:24 @@ -12,7 +12,7 @@ ;;; Code: -(defvar jao-notify-use-messages-p nil) +(defvar jao-notify-use-messages nil) (defvar jao-notify-timeout 5000) (defvar jao-notify-audio-icon (jao-data-file "music-player-icon.png")) @@ -23,7 +23,7 @@ (defun jao-notify (msg &optional title icon) (let ((title (when (and title (not (string-blank-p title))) title))) - (if jao-notify-use-messages-p + (if jao-notify-use-messages (message "%s%s%s" (or title "") (if title ": " "") (or msg "")) (let* ((args `(:timeout ,jao-notify-timeout)) (args (append args diff --git a/lib/eos/jao-shell.el b/lib/eos/jao-shell.el index ff1c160..86bf46b 100644 --- a/lib/eos/jao-shell.el +++ b/lib/eos/jao-shell.el @@ -24,25 +24,29 @@ ;;; Code: -(defun jao-shell--quote (x) (shell-quote-argument (format "%s" x))) - -;;;###autoload (defun jao-shell-cmd-lines (cmd &rest args) - (let ((cmd (concat cmd " " (mapconcat #'jao-shell--quote args " ")))) + (let ((cmd (concat cmd " " (combine-and-quote-strings args)))) (split-string (shell-command-to-string cmd) "\n" t))) -;;;###autoload (defun jao-shell-string (cmd &rest args) (string-trim (or (car (apply #'jao-shell-cmd-lines cmd args)) ""))) -;;;###autoload -(defun jao-shell-exec (command) +(defun jao-shell-exec (command &optional wait) (interactive (list (read-shell-command "$ " (if current-prefix-arg (cons (concat " " (buffer-file-name)) 0) "")))) - (start-process-shell-command command nil command)) + (if wait + (call-process-shell-command command) + (start-process-shell-command command nil command))) + +(defun jao-shell-exec* (command-or-wait &rest args) + (let ((wait (and (not (stringp command-or-wait)) command-or-wait)) + (args (if (stringp command-or-wait) (cons command-or-wait args) args))) + (jao-shell-exec (combine-and-quote-strings args) wait))) + +(defun jao-shell-exec-p (command) (eq 0 (jao-shell-exec command t))) (defmacro jao-shell-def-exec (name &rest args) `(defun ,name (&rest other-args) @@ -52,9 +56,14 @@ "*jao-exec - console*" (string-join (append (list ,@args) other-args) " ")))) -;;;###autoload -(defun jao-shell-running-p (pr) - (not (string-blank-p (shell-command-to-string (concat "pidof " pr))))) +(defun jao-shell-output (cmd handler) + (with-temp-buffer + (call-process-shell-command cmd nil (current-buffer)) + (beginning-of-buffer) + (funcall handler))) + +(defun jao-shell-running-p (pr) (eq 0 (jao-shell-exec* t "pidof" pr))) +(defun jao-shell-kill-p (pr) (eq 0 (jao-shell-exec* t "killall" pr))) (provide 'jao-shell) ;;; jao-shell.el ends here diff --git a/lib/eos/jao-sleep.el b/lib/eos/jao-sleep.el index 93da0e7..b047373 100644 --- a/lib/eos/jao-sleep.el +++ b/lib/eos/jao-sleep.el @@ -41,12 +41,12 @@ "Register actions to take on sleep and on awake, using the system D-BUS." (when (featurep 'dbusbind) (setq jao-sleep--dbus-sleep-registration-object - (dbus-register-signal (if session-dbus :session :system) - "org.freedesktop.login1" - "/org/freedesktop/login1" - "org.freedesktop.login1.Manager" - "PrepareForSleep" - #'jao-sleep--dbus-sleep-handler)))) + (dbus-register-signal (if session-dbus :session :system) + "org.freedesktop.login1" + "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" + "PrepareForSleep" + #'jao-sleep--dbus-sleep-handler)))) ;;;###autoload (defun jao-sleep-dbus-unregister () diff --git a/lib/eos/jao-tracking.el b/lib/eos/jao-tracking.el index 520116d..2af868c 100644 --- a/lib/eos/jao-tracking.el +++ b/lib/eos/jao-tracking.el @@ -1,6 +1,6 @@ -;;; jao-minibuffer-tracking.el --- Tracking notifications in minibuffer -*- lexical-binding: t; -*- +;; jao-minibuffer-tracking.el --- Tracking notifications -*- lexical-binding: t; -*- -;; Copyright (C) 2021 jao +;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -18,33 +18,33 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. -;;; Code: +;;; require (require 'tracking) (require 'shorten) (require 'jao-minibuffer) +(require 'jao-afio) - -;; shorten +;;; shorten +;;;###autoload (defun jao-shorten-modes (&rest modes) (dolist (m modes) (add-to-list 'tracking-shorten-modes m))) -(defun jao-tracking--clean-slack (s) - (let* ((s (replace-regexp-in-string - "^\\*Slack - .*? : \\(mpdm-\\)?\\([^ ]+\\)\\( \\(T\\)\\)?.*" - "#\\2\\4" - s)) - (s (replace-regexp-in-string "logstash-\\([^-]+\\)-\\(.+\\)" - "\\2-\\1" - s))) - (replace-regexp-in-string "^[^a-zA-Z#]+" "#" s))) +(defvar jao-tracking-cleaners '(("^[^a-zA-Z#@]+" . "#"))) + +;;;###autoload +(defun jao-tracking-cleaner (rx subst) + (add-to-list 'jao-tracking-cleaners (cons rx subst))) (defun jao-tracking-shorten-aggressively (lst tail-count) - (let* ((s (shorten-join-sans-tail lst tail-count))) + (let ((s (shorten-join-sans-tail lst tail-count))) (if (string-match-p "^#" s) (substring s 1 nil) s))) (defun jao-tracking-split-clean (s) - (shorten-split (jao-tracking--clean-slack s))) + (dolist (cln jao-tracking-cleaners) + (when (string-match (car cln) s) + (setq s (replace-match (cdr cln) nil nil s)))) + (shorten-split s)) (defun jao-tracking-shorten (old-func &rest args) (let ((shorten-join-function #'jao-tracking-shorten-aggressively) @@ -53,14 +53,15 @@ (advice-add #'tracking-shorten :around #'jao-tracking-shorten) - -;; additional highlighting +;;; additional highlighting (defvar jao-tracking-highlight-rx "$^") +;;;###autoload (defun jao-tracking-faces (&rest faces) (dolist (face faces) (add-to-list 'tracking-faces-priorities face))) +;;;###autoload (defun jao-tracking-add-buffer (old-func &rest args) (let* ((buffer (car args)) (faces (if (and buffer @@ -73,8 +74,7 @@ (advice-add 'tracking-add-buffer :around #'jao-tracking-add-buffer) (jao-tracking-faces 'lui-highlight-face) - -;; minibuffer +;;; minibuffer (defvar jao-tracking-string "") (defvar jao-tracking-bkg "grey93") @@ -84,11 +84,21 @@ `((t :foreground ,jao-tracking-bkg :background ,jao-tracking-bkg)) "" :group 'faces) +(defvar jao-tracking--pipe + (let ((name "/tmp/emacs.status")) + (unless (file-exists-p name) + (shell-command (format "mkfifo %s" name name))) + name)) + (defun jao-tracking-set-log (v) (when (member window-system '(x)) - (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0))) - -(jao-tracking-set-log "") + (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0)) + (if jao-wayland-enabled + (let ((inhibit-message t)) + (shell-command (format "echo \"%s\" > %s" v jao-tracking--pipe))) + (let* ((action (if (string-blank-p v) "remove" "add")) + (cmd (format "wmctrl -r emacs -b %s,demands_attention" action))) + (shell-command-to-string cmd)))) (defun jao-tracking--buffer-str (s) (if (listp s) @@ -114,10 +124,59 @@ (setq jao-tracking-string (jao-tracking-build-str new-val)) (jao-minibuffer-refresh)) -(jao-minibuffer-add-variable 'jao-tracking-string -10) -(add-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) -;; since we're using the minibuffer, forget the mode line -(advice-add #'tracking-mode :override (lambda (&optional _) (interactive))) +(defvar jao-tracking-use-scratch 5) +(defvar jao-tracking--start-frame nil) + +(defun jao-tracking--remove-visible-buffers () + (unless (and jao-afio-use-frames jao-tracking-use-scratch) + (tracking-remove-visible-buffers))) + +;;; package setup +;;;###autoload +(defun jao-tracking-go-to-chats () + (interactive) + (when jao-tracking-use-scratch + (jao-afio-goto-nth jao-tracking-use-scratch))) + +;;;###autoload +(defun jao-tracking-next-buffer () + (interactive) + (if jao-tracking-use-scratch + (let ((k (if (numberp jao-tracking-use-scratch) jao-tracking-use-scratch 0)) + (n (jao-afio-frame-no))) + (unless (eq k n) (setq jao-tracking--start-frame n)) + (cond (tracking-buffers + (let ((bs tracking-buffers)) + (if (eq k n) + (tracking-next-buffer) + (jao-afio-goto-nth k) + (when (and (car bs) (not (memq (current-buffer) bs))) + (pop-to-buffer (car bs))) + (tracking-remove-visible-buffers)))) + (jao-tracking--start-frame + (jao-afio-goto-nth jao-tracking--start-frame) + (setq jao-tracking--start-frame nil)))) + (tracking-next-buffer)) + (jao-tracking-update-minibuffer)) + +(defun jao-tracking-add-to-minibuffer () + (interactive) + (jao-minibuffer-add-variable 'jao-tracking-string -10) + (add-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) + (advice-add #'tracking-mode :override (lambda (&optional _) (interactive)))) + +(defun jao-tracking-remove-from-minibuffer () + (interactive) + (jao-minibuffer-remove-variable 'jao-tracking-string) + (remove-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) + (advice-remove #'tracking-mode (lambda (&optional _) (interactive)))) + +;;;###autoload +(defun jao-tracking-setup (&optional minibuffer) + (when minibuffer (jao-tracking-add-to-minibuffer)) + (add-hook 'jao-afio-switch-hook #'jao-tracking--remove-visible-buffers) + (global-set-key (kbd "C-c C-SPC") #'jao-tracking-next-buffer) + (define-key tracking-mode-map (kbd "C-c C-SPC") #'jao-tracking-next-buffer)) (provide 'jao-tracking) ;;; jao-minibuffer-tracking.el ends here diff --git a/lib/eos/jao-wayland.el b/lib/eos/jao-wayland.el new file mode 100644 index 0000000..9458ccb --- /dev/null +++ b/lib/eos/jao-wayland.el @@ -0,0 +1,181 @@ +;;; jao-wayland.el --- interacting with wayland compositors -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2023 jao + +;; Author: jao <mail@jao.io> +;; Keywords: convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(require 'jao-shell) +(require 'jao-pdf) +(require 'jao-tracking) + +;;; wayland +(defvar jao-wayland-enabled + (string= "wayland" (or (getenv "XDG_SESSION_TYPE") ""))) + +(defsubst jao-wayland-type (&rest args) + (apply #'jao-shell-exec* t "wtype" args)) + +;;; river +(defvar jao-river-enabled (jao-shell-running-p "river")) +(defun jao-river-enabled-p () jao-river-enabled) + +(defsubst jao-river-to-ws (n) + (jao-wayland-type "-M" "win" (format "%s" n))) + +(defsubst jao-river-window-list () + (alist-get 'toplevels + (jao-shell-output "lswt -j" + (lambda () + (let ((json-false nil)) (json-read)))))) + +(defun jao-river-focused () + (seq-some (lambda (w) (and (alist-get 'activated w) w)) + (jao-river-window-list))) + +(defsubst jao-river-get-focused-title () + (alist-get 'title (jao-river-focused))) + +(defsubst jao-river-get-focused-app-id () + (alist-get 'app-id (jao-river-focused))) + +(defun jao-river-focus-window (title &optional rx) + (let* ((ws (jao-river-window-list)) + (fltr (if rx #'string-match-p #'string=)) + (w (seq-find (lambda (w) + (or (funcall fltr title (alist-get 'app_id w "")) + (funcall fltr title (alist-get 'title w "")))) + ws))) + (or (alist-get 'activated w) + (seq-some (lambda (_ignored) + (jao-shell-exec "riverctl focus-view next" t) + (or (funcall fltr title (jao-river-get-focused-app-id)) + (funcall fltr title (jao-river-get-focused-title)))) + (and w ws))))) + +(defun jao-river-zathura-to-org () + (let ((title (jao-river-get-focused-title))) + (jao-river-to-ws 1) + (jao-org-open-from-zathura title t))) + +(defun jao-river-zathura-kill-link () + (when-let* ((title (jao-river-get-focused-title)) + (lnk (jao-pdf-zathura-org-link title))) + (jao-river-to-ws 1) + (kill-new lnk) + (message "Link to %s killed" title))) + +(defun jao-river-find-zathura-window (file) + (let ((frx (regexp-quote (file-name-nondirectory file)))) + (seq-some (lambda (w) + (and (string-suffix-p ".zathura" (alist-get 'app_id w "")) + (string-match-p frx (alist-get 'title w "")) + w)) + (jao-river-window-list)))) + +(defun jao-river-open-with-zathura (file page) + (let ((wd (jao-river-find-zathura-window file))) + (jao-river-to-ws 3) + (or (and wd (jao-river-focus-window (alist-get 'title wd))) + (jao-shell-exec* "riverctl" "spawn" (jao-pdf-zathura-open-cmd file page))) + (when page (sit-for 0.2) (jao-wayland-type (format "%dg" page))))) + +(defun jao-river-set-wallpaper (f) + (jao-shell-kill-p "swaybg") + (jao-shell-exec* "riverctl" "spawn" (concat "swaybg -m fill -i " f))) + +(defun jao-river-restart-i3bar () + (interactive) + (jao-shell-kill-p "i3bar-river") + (jao-shell-exec "riverctl spawn i3bar-river") + (sit-for 0.2) + (jao-tracking-set-log "")) + +(defun jao-river-toggle-emacs () + (let ((erx "^p?emacs\\(client\\)?\\|\\(.* - emacs\\)")) + (if (or (string-match-p erx (jao-river-get-focused-title)) + (string-match-p erx (jao-river-get-focused-app-id))) + (jao-shell-exec "riverctl focus-previous-tags") + (jao-river-to-ws 1) + (unless (jao-river-focus-window erx t) + (jao-shell-exec* "riverctl" "spawn" "efoot"))))) + +(defun jao-river-toggle-firefox () + (if (string-match-p "Firefox" (or (jao-river-get-focused-app-id) "")) + (jao-river-to-ws 1) + (jao-river-to-ws 2) + (unless (jao-river-focus-window "Firefox") + (jao-shell-exec* "riverctl" "spawn" "firefox")))) + +;;; sway +(defun jao-sway-msg (msg) + (shell-command (format "swaymsg '%s' >/dev/null" msg))) + +(defmacro jao-def-swaymsg (name msg) + `(defun ,(intern (format "jao-sway-%s" name)) () + (interactive) + (jao-sway-msg ,msg))) + +(jao-def-swaymsg firefox "[app_id=Firefox] focus") +(jao-def-swaymsg pemacs "[app_id=pemacs] focus") + +(defvar jao-sway-enabled (jao-shell-running-p "sway")) + +(defconst jao-sway-get-active-title + "swaymsg -t get_tree | jq '.. | select(.type?) | select(.focused==true).name'") + +(defconst jao-sway-get-active-app + "swaymsg -t get_tree | jq '.. | select(.type?) | select(.focused==true).app_id'") + +(defun jao-sway-get-active-title () + (let ((tl (jao-shell-string jao-sway-get-active-title))) + (and (string-match "\"\\(.+\\)\"" tl) (match-string 1 tl)))) + +(defun jao-sway-get-active-app () + (let ((tl (jao-shell-string jao-sway-get-active-app))) + (and (string-match "\"\\(.+\\)\"" tl) (match-string 1 tl)))) + +(defun jao-sway-zathura-org () + (jao-org-open-from-zathura (jao-sway-get-active-title) t)) + +(defun jao-sway-open-with-zathura (file page) + (let* ((n (file-name-nondirectory file)) + (m (format "[title=\"%s\" app_id=\".*zathura\"] focus" n))) + (jao-sway-msg "workspace number 3") + (unless (= 0 (jao-sway-msg m)) + (jao-shell-exec (jao-pdf-zathura-open-cmd file page))) + (when page (sit-for 0.2) (jao-wayland-type (format "%dg" page))))) + +(defun jao-sway-set-wallpaper (f) + (jao-sway-msg (format "output * bg %s fill" f))) + +(defun jao-sway-run-or-focus (cmd &optional ws) + (if (jao-shell-running-p "firefox") + (jao-sway-msg (format "[app_id=%s] focus" cmd)) + (jao-sway-msg (format "workspace %s" (or ws 2))) + (start-process-shell-command cmd nil cmd))) + +(defun jao-sway-run-or-focus-firefox () + (interactive) + (jao-sway-run-or-focus "firefox")) + +(defun jao-sway-toggle-emacs () + (if (string-match-p "p?emacs" (jao-sway-get-active-app)) + (jao-sway-firefox) + (jao-sway-pemacs))) + +(provide 'jao-wayland) +;;; jao-wayland.el ends here diff --git a/lib/media/jao-lyrics.el b/lib/media/jao-lyrics.el index 5008fae..985c9d9 100644 --- a/lib/media/jao-lyrics.el +++ b/lib/media/jao-lyrics.el @@ -76,7 +76,7 @@ (use-local-map jao-lyrics-mode-map) (setq major-mode 'jao-lyrics-mode) (setq mode-name "lyrics") - (toggle-read-only 1)) + (read-only-mode)) (defun jao-lyrics-buffer () (or (get-buffer "*Lyrics*") diff --git a/lib/media/jao-mpc.el b/lib/media/jao-mpc.el index dc8ff6d..4f5081c 100644 --- a/lib/media/jao-mpc.el +++ b/lib/media/jao-mpc.el @@ -1,6 +1,6 @@ ;;; jao-mpc.el --- Using mpc to interact with mpd -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022 jao +;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: convenience @@ -38,62 +38,88 @@ (defvar-local jao-mpc--port nil) (defun jao-mpc--cmd (cmd &optional port) - (let ((port (or port jao-mpc--port jao-mpc-port))) - (shell-command-to-string (format "mpc -p %s %s" port cmd)))) + (let* ((port (or port jao-mpc--port jao-mpc-port)) + (r (shell-command-to-string (format "mpc -p %s %s" port cmd)))) + (replace-regexp-in-string "^\\(warning: \\)?MPD .+\n" "" r))) + +(defun jao-mpc--fformat (fields) + (mapconcat (lambda (f) (format "%s:::%%%s%%" f f)) fields "\n")) (defconst jao-mpc--fields '(artist album composer originaldate genre title track position time name)) (defconst jao-mpc--stfmt - (mapconcat (lambda (f) (format "%s:::%%%s%%" f f)) jao-mpc--fields "\n")) + (jao-mpc--fformat + '(artist album composer originaldate genre title track name))) + +(defconst jao-mpc--stfmtt + (jao-mpc--fformat '(currenttime totaltime percenttime songpos length))) + +(defmacro jao-mpc--parse-fields (res-str res) + `(dolist (s (split-string ,res-str "\n" t " ") ,res) + (when (string-match "\\(.+\\):::\\(.+\\)" s) + (push (cons (intern (match-string 1 s)) (match-string 2 s)) ,res)))) (defun jao-mpc--current (&optional port) (let ((s (jao-mpc--cmd (format "-f '%s' current" jao-mpc--stfmt) port)) + (st (jao-mpc--cmd (format "status '%s'" jao-mpc--stfmtt))) (res)) - (dolist (s (split-string s "\n" t " ") res) - (when (string-match "\\(.+\\):::\\(.+\\)" s) - (push (cons (intern (match-string 1 s)) (match-string 2 s)) res))))) + (jao-mpc--parse-fields s res) + (jao-mpc--parse-fields st res))) + +(defsubst jao-mpc-status (&optional port) + (string-trim (jao-mpc--cmd "status %state%" port))) -(defun jao-mpc--playing-p (&optional port) - (not (string-blank-p (jao-mpc--cmd "status|grep '\\[playing\\]'" port)))) +(defsubst jao-mpc-playing-p (&optional port) + (string-prefix-p "playing" (jao-mpc-status port))) -(defun jao-mpc--queue-len (&optional port) - (string-to-number (jao-mpc--cmd "playlist|wc -l" port))) +(defsubst jao-mpc--queue-len (&optional port) + (string-to-number (jao-mpc--cmd "status %length%" port))) (defsubst jao--put-face (str face) (put-text-property 0 (length str) 'face face str) str) -(defun jao-mpc--current-str (&optional port current len) - (let* ((current (or current (jao-mpc--current port))) - (len (or len (jao-mpc--queue-len port))) - (title (alist-get 'title current (alist-get 'name current ""))) - (album (alist-get 'album current)) - (artist (alist-get 'artist current)) - (composer (alist-get 'composer current)) - (no (string-to-number (alist-get 'position current "0"))) - (time (alist-get 'time current ""))) - (format "> %s%s %s%s%s%s" ;; - (jao--put-face (if (zerop no) "" (format "%02d/%s " no len)) - 'jao-themes-f02) - (jao--put-face title 'jao-themes-f00) - (jao--put-face artist 'jao-themes-f01) - (jao--put-face (if composer (format " [%s]" composer) "") - 'jao-themes-f01) - (jao--put-face (if album (format " (%s)" album) "") 'jao-themes-f11) - (if (string-blank-p time) - "" - (jao--put-face (format " [%s]" time) 'jao-themes-dimm))))) +(defun jao-mpc--current-timestr (playing-times &optional current) + (let* ((current (or current (jao-mpc--current))) + (time (alist-get 'totaltime current ""))) + (if playing-times + (format "%s/%s%s" + (alist-get 'currenttime current "") + time + (alist-get 'percenttime current "")) + (format "%s" time)))) + +(defun jao-mpc--current-str (&optional port times) + (if-let* ((current (jao-mpc--current port)) + (title (alist-get 'title current (alist-get 'name current)))) + (let ((len (alist-get 'length current "0")) + (album (alist-get 'album current)) + (artist (alist-get 'artist current)) + (composer (alist-get 'composer current)) + (no (string-to-number (alist-get 'songpos current "0"))) + (tims (concat " [" (jao-mpc--current-timestr times current) "]"))) + (format "%s%s %s%s%s%s" ;; + (jao--put-face (if (zerop no) "" (format "%d/%s " no len)) + 'jao-themes-f02) + (jao--put-face (or title "") 'jao-themes-f00) + (jao--put-face (or artist "") 'jao-themes-f01) + (jao--put-face (if composer (format " [%s]" composer) "") + 'jao-themes-f01) + (jao--put-face (if album (format " (%s)" album) "") 'jao-themes-f11) + (jao--put-face tims (if times 'jao-themes-f00 'jao-themes-dimm)))) + "")) (defvar jao-mpc-minibuffer-str "") (defun jao-mpc--set-current-str (&optional port) - (setq jao-mpc-minibuffer-str - (if (jao-mpc--playing-p port) - (jao-mpc--current-str port) - (when (and (null port) jao-random-album-p (not (jao-mpc--current))) - (jao-random-album-next)) - "")) + (let ((status (or (jao-mpc-status port) ""))) + (setq jao-mpc-minibuffer-str + (if (string= "playing" status) (jao-mpc--current-str port) "")) + (when (and jao-random-album-active + (or (string= status "stopped") (string= status "paused")) + (string= "0\n" (jao-mpc--cmd "status %songpos%" port))) + (jao-random-album-next))) (jao-minibuffer-refresh)) (defvar jao-mpc--idle-procs nil) @@ -109,11 +135,13 @@ "idleloop" "player") :filter (lambda (_p _s) (jao-mpc--set-current-str port))))) +(defvar jao-mpc--browser-port nil) + (define-derived-mode jao-mpc-albums-mode fundamental-mode "MPC Albums" "Mode to display the list of albums known by mpd." (read-only-mode -1) (delete-region (point-min) (point-max)) - (insert (jao-mpc--cmd "list album")) + (insert (jao-mpc--cmd "list album" jao-mpc--browser-port)) (goto-char (point-min)) (read-only-mode 1)) @@ -124,12 +152,13 @@ (jao-mpc-albums-mode) (current-buffer)))) -(defun jao-mpc--add-and-play (&optional album) +(defun jao-mpc--add-and-play (&optional album port idp) (interactive) - (let ((album (or album (string-trim (thing-at-point 'line))))) - (jao-mpc--cmd "clear") - (jao-mpc--cmd (format "findadd album \"%s\"" album)) - (jao-mpc--cmd "play"))) + (let ((a (or album (string-trim (thing-at-point 'line)))) + (p (or port jao-mpc--browser-port))) + (jao-mpc--cmd "clear" p) + (jao-mpc--cmd (if idp (concat "add " a) (format "findadd album \"%s\"" a)) p) + (jao-mpc--cmd "play" p))) (define-key jao-mpc-albums-mode-map (kbd "n") #'next-line) (define-key jao-mpc-albums-mode-map (kbd "p") #'previous-line) @@ -170,15 +199,22 @@ (let ((jao-mpc-port (or port jao-mpc-port))) (jao-mpc-playlist-mode)) (current-buffer))) +(defun jao-mpc--with-delayed-random-album (cmd port) + (let ((st jao-random-album-active)) + (setq jao-random-album-active nil) + (jao-mpc--cmd cmd port) + (accept-process-output nil 0.5) + (setq jao-random-album-active st))) + ;;;###autoload (defun jao-mpc-stop (&optional port) (interactive) - (jao-mpc--cmd "stop" port)) + (jao-mpc--with-delayed-random-album "stop" port)) ;;;###autoload (defun jao-mpc-toggle (&optional port) (interactive) - (jao-mpc--cmd "toggle" port)) + (jao-mpc--with-delayed-random-album "toggle" port)) ;;;###autoload (defun jao-mpc-play (&optional port) @@ -208,7 +244,12 @@ ;;;###autoload (defun jao-mpc-echo-current (&optional port) (interactive) - (jao-notify (jao-mpc--current-str port))) + (message "%s" (jao-mpc--current-str port t))) + +;;;###autoload +(defun jao-mpc-echo-current-times (&optional port) + (interactive) + (message "Playing time: %s" (jao-mpc--current-timestr t))) ;;;###autoload (defun jao-mpc-add-url (url) @@ -216,9 +257,33 @@ (jao-mpc--cmd (format "add %s" url))) ;;;###autoload -(defun jao-mpc-show-albums () +(defun jao-mpc-add-or-play-url (url &optional play) + "Add the given URL to mpc's playing list, or just play it." + (let ((p (or play (yes-or-no-p (format "Play %s right now?" url))))) + (when p (jao-mpc-clear)) + (jao-mpc-add-url url) + (if p (jao-mpc-play) (message "%s added to mpc queue" url)))) + +(defvar jao-mpc-stream-urls + '(("classic fm" . "http://media-ice.musicradio.com:80/ClassicFMMP3") + ("wcpe" . "http://audio-mp3.ibiblio.org:8000/wcpe.mp3") + ("davide of mimic" . "http://streaming01.zfast.co.uk:8018/stream") + ("cinemix" . "http://94.23.51.96:8000") ;; 209.9.238.4:6022 209.9.238.4:6046 + ("bbc gold" . "http://media-ice.musicradio.com:80/GoldMP3") + ("irish gold" . "http://icecast2.rte.ie/gold"))) + +;;;###autoload +(defun jao-mpc-play-stream () + "Select a predefined stream URL and add or play it in mpc." + (interactive) + (let ((s (completing-read "Stream: " jao-mpc-stream-urls))) + (jao-mpc-add-or-play-url (cdr (assoc s jao-mpc-stream-urls)) t))) + +;;;###autoload +(defun jao-mpc-show-albums (&optional port) "Show album list." (interactive) + (setq jao-mpc--browser-port port) (pop-to-buffer (jao-mpc--album-buffer))) ;;;###autoload @@ -239,35 +304,35 @@ (defun jao-mpc-connect (&optional port) (interactive) (jao-mpc--idle-loop port) - (when (jao-mpc--playing-p port) (jao-mpc--set-current-str port))) + (when (jao-mpc-playing-p port) (jao-mpc--set-current-str port))) ;;;###autoload (defun jao-mpc-setup (&optional secondary-port priority) (setq jao-lyrics-info-function #'jao-mpc-lyrics-track-data) (jao-random-album-setup #'jao-mpc--album-buffer #'jao-mpc--add-and-play - #'jao-mpc-stop - jao-notify-audio-icon) - (jao-mpc-connect) + #'jao-mpc-stop) + (let ((jao-random-album-active nil)) (jao-mpc-connect)) (when secondary-port (jao-mpc-connect secondary-port)) (when priority (if (> priority 0) (jao-minibuffer-add-variable 'jao-mpc-minibuffer-str priority) (jao-minibuffer-add-msg-variable 'jao-mpc-minibuffer-str (- priority))))) -(defvar jao-mpc--album-titles nil) (defconst jao-mpc--albums-cmd "-f '%album% - %artist%' find \"(ALBUM =~ '.*')\" | uniq") +(defconst jao-mpc--simple-albums-cmd "list album") ;;;###autoload -(defun jao-mpc-select-album (refresh) - (interactive "P") - (let ((albums (or (and (not refresh) jao-mpc--album-titles) - (setq jao-mpc--album-titles - (split-string (jao-mpc--cmd jao-mpc--albums-cmd) - "\n" t))))) +(defun jao-mpc-select-album (&optional port) + (interactive) + (let* ((albums-str (jao-mpc--cmd jao-mpc--albums-cmd port)) + (albums-str (if (string= "" albums-str) + (jao-mpc--cmd jao-mpc--simple-albums-cmd port) + albums-str)) + (albums (split-string albums-str "\n" t))) (when-let (album (completing-read "Play album: " albums nil t)) - (jao-mpc--add-and-play (car (split-string album "-" t " ")))))) + (jao-mpc--add-and-play (car (split-string album "-" t " ")) port)))) (provide 'jao-mpc) ;;; jao-mpc.el ends here diff --git a/lib/media/jao-mpris.el b/lib/media/jao-mpris.el index 47a35a7..80d0675 100644 --- a/lib/media/jao-mpris.el +++ b/lib/media/jao-mpris.el @@ -1,6 +1,6 @@ ;;; jao-mpris.el --- mpris players control -*- lexical-binding: t; -*- -;; Copyright (C) 2020, 2021, 2022 jao +;; Copyright (C) 2020, 2021, 2022, 2024, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: multimedia @@ -119,7 +119,7 @@ (duration (cond (duration duration) ((stringp len) len) ((numberp len) (jao-mpris--fmt-time (/ len 1e6) ""))))) - (format "> %s %s %s%s%s" + (format "%s %s %s%s%s" (jao--put-face (format "%s" (or track "")) 'jao-themes-f00) (jao--put-face (or title "") 'jao-themes-f01) (jao--put-face (or artist "") 'jao-themes-f11) @@ -130,6 +130,7 @@ (defun jao-mpris--track (&optional info) (let ((info (or info (jao-playerctl--status)))) + (setq jao-mpris--current info) (if (string= "Playing" (jao-mpris--get 'status info)) (setq jao-mpris-track-string (jao-mpris--format info)) (setq jao-mpris-track-string ""))) @@ -157,25 +158,25 @@ (defun jao-mpris--handler (iname properties &rest _args) (let ((inhibit-message t)) - (message "Received properties: %S from %s" properties iname)) - (when-let (md (caadr (assoc "Metadata" properties))) - (let ((tno (caadr (assoc "xesam:trackNumber" md))) - (tlt (caadr (assoc "xesam:title" md))) - (art (caadr (assoc "xesam:artist" md))) - (alb (caadr (assoc "xesam:album" md))) - (len (caadr (assoc "mpris:length" md)))) - (if (string= (or tlt "") "TIDAL") - (jao-mpris-reset) + (message "Received properties: %S from %s" properties iname) + (when-let (md (caadr (assoc "Metadata" properties))) + (let ((tno (caadr (assoc "xesam:trackNumber" md))) + (tlt (caadr (assoc "xesam:title" md))) + (art (caadr (assoc "xesam:artist" md))) + (alb (caadr (assoc "xesam:album" md))) + (len (caadr (assoc "mpris:length" md)))) (jao-mpris--set-current 'track tno) (jao-mpris--set-current 'title tlt) (jao-mpris--set-current 'artist art) (jao-mpris--set-current 'album alb) - (jao-mpris--set-current 'length len)))) - (when-let (st (caadr (assoc "PlaybackStatus" properties))) - (jao-mpris--set-current 'status st) - (when (string= st "Stopped") - (dolist (k '(track title artist album length)) - (jao-mpris--del-current k)))) + (jao-mpris--set-current 'length len))) + (when-let (st (caadr (assoc "PlaybackStatus" properties))) + (jao-mpris--set-current 'status st) + (when (string= st "Stopped") + (dolist (k '(track title artist album length)) + (jao-mpris--del-current k)))) + ;; (message "Current is: %S" jao-mpris--current) + ) (jao-mpris--track jao-mpris--current)) ;;;###autoload diff --git a/lib/media/jao-random-album.el b/lib/media/jao-random-album.el index 2800115..3b2915b 100644 --- a/lib/media/jao-random-album.el +++ b/lib/media/jao-random-album.el @@ -1,6 +1,6 @@ ;; jao-random-album.el -- play random albums -;; Copyright (C) 2009, 2010, 2017, 2018, 2019, 2021 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010, 2017-2019, 2021-2022, 2024 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Start date: Sat Jul 04, 2009 13:06 @@ -18,13 +18,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. -(require 'jao-notify) - -(defvar jao-random-album-p t) +(defvar jao-random-album-active t) (defvar jao-random-lines nil) (defvar jao-random-lines-file (expand-file-name "~/.emacs.d/random-lines")) -(defvar jao-random-album-notify-p t) -(defvar jao-random-album-notify-icon jao-notify-audio-icon) +(defvar jao-random-album-notify nil) (defvar jao-random-album-skip-lines 2) (defun jao-random-lines () @@ -60,19 +57,19 @@ (defun jao-random-album-start () (interactive) - (setq jao-random-album-p t) + (setq jao-random-album-active t) (jao-random-album-next)) (defun jao-random-album-stop () (interactive) - (setq jao-random-album-p nil) + (setq jao-random-album-active nil) (funcall jao-random-album-stop)) (defun jao-random-album-toggle () (interactive) - (setq jao-random-album-p (not jao-random-album-p)) + (setq jao-random-album-active (not jao-random-album-active)) (message "Random album %s" - (if jao-random-album-p "enabled" "disabled"))) + (if jao-random-album-active "enabled" "disabled"))) (defun jao-random-album-next () (interactive) @@ -80,19 +77,18 @@ (jao-goto-random-album) (let ((album (string-trim (thing-at-point 'line)))) (funcall jao-random-album-add-tracks-and-play album) - (when jao-random-album-notify-p - (jao-notify album "Next album" jao-random-album-notify-icon))))) + (when jao-random-album-notify + (funcall jao-random-album-notify album))))) (defun jao-random-album-reset () (interactive) (setq jao-random-lines nil) (jao-random-lines-save)) -(defun jao-random-album-setup (album-buffer add-and-play stop &optional icon) +(defun jao-random-album-setup (album-buffer add-and-play stop) (setq jao-random-album-buffer album-buffer jao-random-album-add-tracks-and-play add-and-play - jao-random-album-stop stop - jao-random-album-notify-icon icon)) + jao-random-album-stop stop)) (provide 'jao-random-album) diff --git a/lib/media/jao-spt.el b/lib/media/jao-spt.el index 4484ead..ba5d104 100644 --- a/lib/media/jao-spt.el +++ b/lib/media/jao-spt.el @@ -1,6 +1,6 @@ ;;; jao-spt.el --- Access to the spotify-tui CLI -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022 jao +;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: multimedia @@ -27,7 +27,7 @@ (require 'jao-minibuffer) (require 'jao-notify) -(defvar jao-spt-bin (expand-file-name "~/bin/spt")) +(defvar jao-spt-bin "spt") (defvar jao-spt-format "'%s %t - %a [%r] %f'") (defvar jao-spt-device nil) @@ -48,7 +48,7 @@ st)) (defun jao-spt--pb* (&rest args) - (message (apply 'jao-spt--pb args))) + (message "%s" (apply 'jao-spt--pb args))) ;;;###autoload (defun jao-spt-play-uri (uri) @@ -119,7 +119,7 @@ ;;;###autoload (defun jao-spt-echo-current () (interactive) - (let ((jao-notify-use-messages-p t)) + (let ((jao-notify-use-messages t)) (jao-notify (jao-spt-update-status)))) ;;;###autoload diff --git a/lib/net/jao-eww-session.el b/lib/net/jao-eww-session.el index 9a34656..4ac5447 100644 --- a/lib/net/jao-eww-session.el +++ b/lib/net/jao-eww-session.el @@ -86,7 +86,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (defvar jao-eww-current-session '(jao-eww-session 0 nil)) -(defun jao-eww-session--list-buffers (&optional skip) +(defun jao-eww-session-eww-buffers (&optional skip) (seq-filter (lambda (b) (when (not (eq b skip)) (with-current-buffer b (derived-mode-p 'eww-mode)))) @@ -94,7 +94,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (defun jao-eww-session-invisible-buffers () (seq-filter (lambda (b) (null (get-buffer-window b))) - (jao-eww-session--list-buffers (current-buffer)))) + (jao-eww-session-eww-buffers (current-buffer)))) (defun jao-eww--current-url () (when-let (url (eww-current-url)) (url-encode-url url))) @@ -104,7 +104,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (cb (current-buffer)) (pos 0) (count 0)) - (dolist (b (jao-eww-session--list-buffers (when skip-current cb)) + (dolist (b (jao-eww-session-eww-buffers (when skip-current cb)) (list pos (reverse urls))) (set-buffer b) (when-let (url (jao-eww--current-url)) @@ -141,7 +141,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (or (and (eq jao-eww-session-duplicate-tabs 'never)) (not (y-or-n-p (format "'%s' (%s) is already open. Duplicate? " (jao-eww-buffer-title) url)))))))) - (jao-eww-session--list-buffers))) + (jao-eww-session-eww-buffers))) (defun jao-eww-session-load-aux () (let ((new-session (jao-eww-session-from-file @@ -226,7 +226,7 @@ the session is already displayed in a eww tab, jao-eww-session can: (dolist (url urls) (eww url 4)) (seq-each #'kill-buffer buffers) (unless (zerop offset) - (switch-to-buffer (nth offset (jao-eww-session--list-buffers))))))) + (switch-to-buffer (nth offset (jao-eww-session-eww-buffers))))))) (provide 'jao-eww-session) ;;; jao-eww-session.el ends here diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el index e18c5a1..5cd42fa 100644 --- a/lib/net/jao-notmuch-gnus.el +++ b/lib/net/jao-notmuch-gnus.el @@ -1,6 +1,6 @@ ;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- -;; Copyright (C) 2022 jao +;; Copyright (C) 2022, 2024, 2025 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -28,7 +28,6 @@ (require 'ol-gnus) (require 'notmuch-show) - ;;; Tagging in notmuch from Gnus buffers (defun jao-notmuch-gnus--notmuch-id (id) @@ -53,7 +52,7 @@ "Interactively add or remove tags to the current message." (interactive) (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (unless tags (jao-notmuch-gnus-message-tags id))) + (current (or tags (jao-notmuch-gnus-message-tags id))) (prompt (format "Change tags %s" (string-join current "/"))) (tags (or tags (notmuch-read-tag-changes current prompt)))) (notmuch-tag (concat "id:" id) tags) @@ -66,6 +65,11 @@ (when-let (id (jao-notmuch-gnus-message-id)) (message "%s" (string-join (jao-notmuch-gnus-message-tags id) " ")))) +(jao-transient-major-mode+ gnus-summary + ["Tags" + ("s" "show message tags" jao-notmuch-gnus-show-tags) + ("t" "tag message" jao-notmuch-gnus-tag-message)]) + (defun jao-notmuch-gnus-toggle-tags (tags &optional id current) "Toggle the given TAGS list for the current Gnus message." (let* ((id (or id (jao-notmuch-gnus-message-id))) @@ -77,9 +81,9 @@ (message "New tags: %s" (jao-notmuch-gnus-message-tags id)))) (defun jao-notmuch-gnus-tag-mark () - "Remove the new tag for an article when it's marked as seen by Gnus." + "Remove the new and unread tags for an article when it's marked as seen by Gnus." (when-let (id (jao-notmuch-gnus-message-id t)) - (jao-notmuch-gnus-tag-message id '("-new") t))) + (jao-notmuch-gnus-tag-message id '("-new" "-unread") t))) (add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark) @@ -100,16 +104,26 @@ (add-hook 'gnus-summary-article-move-hook #'jao-notmuch-gnus-tag-on-move) (add-hook 'gnus-summary-article-expire-hook #'jao-notmuch-gnus-tag-on-move)) - -;;;; Displaying search results in Gnus +;;; Gnus search using notmuch + +(require 'gnus-search) + +(add-to-list 'gnus-search-expandable-keys "list") + +(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) + (expr (head list))) + (format "List:%s" (gnus-search-transform-expression engine (cdr expr)))) + + +;;; Displaying search results in Gnus (defvar jao-notmuch-gnus-server "nnml" "Name of the target Gnus server, e.g. nnml+mail.") -(defvar jao-notmuch-gnus-mail-directory (expand-file-name "~/.emacs.d/gnus/Mail") +(defvar jao-notmuch-gnus-mail-directory (expand-file-name "~/var/mail/gnus") "Directory where Gnus stores its mail.") -(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/news") +(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/mail/news") "Directory where leafnode stores its messages as seen by notmuch.") (defun jao-notmuch-gnus-file-to-group (file &optional maildir newsdir) @@ -164,8 +178,14 @@ Example: (org-gnus-follow-link group msg-id) (message "Couldn't get relevant infos for switching to Gnus.")))) - -;;;; Org links +(defun jao-notmuch-gnus-engine (prefix config) + (let ((prefix (file-name-as-directory (expand-file-name prefix "~"))) + (config (expand-file-name config gnus-home-directory))) + `(gnus-search-engine gnus-search-notmuch + (remove-prefix ,prefix) + (config-file ,config)))) + +;;; Org links (defun jao-notmuch-gnus--fname (id) (let ((cmd (format "notmuch search --output=files id:%s" id))) (car (split-string (shell-command-to-string cmd))))) @@ -193,14 +213,13 @@ Example: (org-link-set-parameters "gnus" :store #'ignore) (org-link-set-parameters "notmuch" :store #'ignore) - -;;;; consult-notmuch +;;; consult-notmuch (with-eval-after-load "consult-notmuch" (defun jao-notmuch-gnus--open-candidate (candidate) "Open a notmuch-search completion candidate email in Gnus." (message "candidate: %S" candidate) - (jao-notmuch-gnus-goto-message (consult-notmuch--thread-id candidate))) + (jao-notmuch-gnus-goto-message (consult-notmuch--candidate-id candidate))) (defun jao-gnus-consult-notmuch () "Run a consult-notmuch query that opens candidates in Gnus." @@ -209,5 +228,19 @@ Example: (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) +;;; tags and flags + +(defun jao-notmuch-gnus-flag-current (&rest _) + (jao-notmuch-gnus-tag-message nil '("+flagged") t)) + +(defun jao-notmuch-gnus-unflag-current (&rest _) + (jao-notmuch-gnus-tag-message nil '("-flagged") t)) + +(advice-add 'gnus-summary-tick-article-forward + :before #'jao-notmuch-gnus-flag-current) +(advice-add 'gnus-summary-mark-as-read-forward + :before #'jao-notmuch-gnus-unflag-current) + +;;; . (provide 'jao-notmuch-gnus) ;;; jao-notmuch-gnus.el ends here diff --git a/lib/net/jao-notmuch.el b/lib/net/jao-notmuch.el index bd48e8f..aef9757 100644 --- a/lib/net/jao-notmuch.el +++ b/lib/net/jao-notmuch.el @@ -1,6 +1,6 @@ -;;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*- +;;; jao-notmuch.el --- Extensions for notmuch -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022 jao +;; Copyright (C) 2021, 2022, 2023, 2024 jao ;; Author: jao <mail@jao.io> ;; Keywords: mail @@ -18,11 +18,9 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. -;;; Commentary: +;; Extensions to vanilla notmuch, mostly for tree view -;; Extensions to vanilla notmuch, mostly for tree view - -;;; Code: +;;; require: (require 'outline) (require 'mm-decode) @@ -32,8 +30,8 @@ (require 'notmuch-tree) (require 'notmuch-show) - -;;;; Targetting the displayed message from the tree view + +;;; targetting the displayed message from the tree view (defvar-local jao-notmuch--tree-buffer nil) (declare eww--url-at-point "eww") @@ -54,12 +52,6 @@ (notmuch-tree-close-message-window) (notmuch-tree-show-message nil))) -(defun jao-notmuch-click-message-buffer () - (interactive) - (let ((b (current-buffer))) - (unless (eq 'url (jao-notmuch-goto-message-buffer t t)) - (pop-to-buffer b)))) - (defun jao-notmuch-tree--find-tree-buffer () (or jao-notmuch--tree-buffer (let ((mb (current-buffer))) @@ -87,7 +79,7 @@ (if (not (jao-notmuch-tree--looking-at-message)) (jao-notmuch-tree-show-or-scroll t) (if (notmuch-tree-scroll-message-window) - (jao-notmuch-tree-next nil) + (notmuch-tree-outline-next) (when (not (window-live-p notmuch-tree-message-window)) (notmuch-tree-show-message nil))))) @@ -130,8 +122,8 @@ (completing-read "Browse URL: " urls)) (message "No URLs in this message"))) - -;;;; Navigating URLs + +;;; navigating URLs (require 'ffap) @@ -157,8 +149,8 @@ (thing-at-point-url-at-point))) (browse-url url))) - -;;;; Toggling mime parts and images + +;;; toggling mime parts and images (defun jao-notmuch--toggle-mime () (save-excursion @@ -207,15 +199,20 @@ (defun jao-notmuch-toggle-images () (interactive) - (cond ((eq mm-text-html-renderer 'w3m) - (when (fboundp 'jao-notmuch--w3m-toggle-images) - (jao-notmuch--w3m-toggle-images))) + (cond ((memq mm-text-html-renderer '(w3m jao-w3m-html-renderer)) + (when (fboundp 'jao-notmuch--w3m-toggle-images) + (jao-notmuch--w3m-toggle-images))) (window-system (jao-notmuch--shr-toggle-images)) - (t (with-current-buffer notmuch-tree-message-buffer - (jao-notmuch--view-html))))) + (notmuch-tree-message-buffer + (if nil ;;(fboundp 'jao-open-in-x-frame) + (let ((w (get-buffer-window notmuch-tree-message-buffer))) + (jao-open-in-x-frame (window-width w) (window-height w)) + (jao-notmuch--shr-toggle-images) + (delete-window)) + (with-current-buffer notmuch-tree-message-buffer + (jao-notmuch--view-html)))))) - -;;;; Keeping track of unread messages in current tree view +;;; header line with thread message counts (defun jao-notmuch--looking-at-new-p (&optional p) (when-let (ts (if p (plist-get p :tags) (notmuch-show-get-tags))) @@ -224,23 +221,24 @@ (defsubst jao-notmuch-tree--first-p (&optional msg) (plist-get (or msg (notmuch-tree-get-message-properties)) :first)) -(defun jao-notmuch--message-counts (&optional thread) - (let ((cnt) (total 0) (match 0) (msg)) - (save-excursion - (if thread - (while (and (not (jao-notmuch-tree--first-p)) - (zerop (forward-line -1)))) - (goto-char (point-min))) - (while (and (setq msg (notmuch-tree-get-message-properties)) - (or (not cnt) - (not thread) - (not (jao-notmuch-tree--first-p msg)))) - (unless cnt (setq cnt 0)) - (setq total (1+ total)) - (when (plist-get msg :match) (setq match (1+ match))) - (when (jao-notmuch--looking-at-new-p msg) (setq cnt (1+ cnt))) - (forward-line 1))) - (when cnt (list total match cnt)))) +(defun jao-notmuch--message-counts (tree-buffer &optional thread) + (with-current-buffer tree-buffer + (let ((cnt) (total 0) (match 0) (msg)) + (save-excursion + (if thread + (while (and (not (jao-notmuch-tree--first-p)) + (zerop (forward-line -1)))) + (goto-char (point-min))) + (while (and (setq msg (notmuch-tree-get-message-properties)) + (or (not cnt) + (not thread) + (not (jao-notmuch-tree--first-p msg)))) + (unless cnt (setq cnt 0)) + (setq total (1+ total)) + (when (plist-get msg :match) (setq match (1+ match))) + (when (jao-notmuch--looking-at-new-p msg) (setq cnt (1+ cnt))) + (forward-line 1))) + (when cnt (list total match cnt))))) (defvar jao-notmuch-header-line-format "%Q [%N / %M / %T] %n / %m / %t") @@ -249,186 +247,149 @@ `((?Q . ,query) (?T . ,total) (?N . ,new) (?M . ,match) (?t . ,ttotal) (?n . ,tnew) (?m . ,tmatch)))) -(defun jao-notmuch--update-header-line (mb) - (let* ((n (or (jao-notmuch--message-counts) '(0 0 0))) - (nc (append n (or (jao-notmuch--message-counts t) '(0 0 0)))) - (q (buffer-name))) - (with-current-buffer mb +(defun jao-notmuch--format-header-line (tree-buffer buffer subject) + (let* ((n (jao-notmuch--message-counts tree-buffer)) + (nc (jao-notmuch--message-counts tree-buffer t))) + (with-current-buffer buffer (when (derived-mode-p 'notmuch-show-mode) - (let* ((s (thread-last (notmuch-show-get-subject) - (notmuch-show-strip-re) - (notmuch-sanitize))) + (let* ((nc (append (or n '(0 0 0)) (or nc '(0 0 0)))) + (q (if (string= tree-buffer subject) "" tree-buffer)) (c (apply 'jao-notmuch--format-counts q nc)) - (n (- (window-width) 3 (string-width s) (string-width c))) - (s (if (< n 0) (substring s 0 (- n 4)) s)) - (n (if (< n 0) 5 (1+ n)))) - (setq-local header-line-format - (concat " " s (make-string n ? ) c))))))) - -(defun jao-notmuch-tree--find-update-header-line (&rest _args) - (when-let ((mb (if (derived-mode-p 'notmuch-show-mode) - (current-buffer) - (window-buffer notmuch-tree-message-window)))) - (seq-find (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'notmuch-tree-mode) - (or (null notmuch-tree-message-buffer) - (eq notmuch-tree-message-buffer mb)) - (jao-notmuch--update-header-line mb)))) - (buffer-list)))) - -(add-hook 'notmuch-after-tag-hook #'jao-notmuch-tree--find-update-header-line) -(add-hook 'notmuch-show-hook #'jao-notmuch-tree--find-update-header-line) - - -;;;; Outline mode for tree view - -(defun jao-notmuch-tree--msg-prefix (msg) - (insert (propertize (if (plist-get msg :first) "> " " ") 'display " "))) - -(defun jao-notmuch-tree--mode-setup () - (setq-local outline-regexp "^> \\|^En") - (outline-minor-mode t)) - -(defun jao-notmuch-tree-hide-others (&optional and-show) - (interactive) - (outline-hide-body) - (outline-show-entry) - (when and-show (notmuch-tree-show-message nil))) - -(defun jao-notmuch-tree--next (prev thread no-exit &optional ignore-new) - (let ((line-move-ignore-invisible nil)) - (cond ((and (not ignore-new) (jao-notmuch--looking-at-new-p))) - (thread - (notmuch-tree-next-thread prev) - (unless (or (not (notmuch-tree-get-message-properties)) - (jao-notmuch--looking-at-new-p)) - (notmuch-tree-matching-message prev (not no-exit)))) - (t (notmuch-tree-matching-message prev (not no-exit))))) - (when (notmuch-tree-get-message-id) - (jao-notmuch-tree-hide-others t)) - (when prev (forward-char 2))) - -(defvar jao-notmuch-tree--prefix-map - (let ((m (make-keymap "Thread operations"))) - (define-key m (kbd "TAB") #'outline-cycle) - (define-key m (kbd "t") #'outline-toggle-children) - (define-key m (kbd "s") #'outline-show-entry) - (define-key m (kbd "S") #'outline-show-all) - (define-key m (kbd "h") #'outline-hide-entry) - (define-key m (kbd "H") #'outline-hide-body) - (define-key m (kbd "o") #'jao-notmuch-tree-hide-others) - (define-key m (kbd "n") #'outline-hide-other) - m)) - -(defun jao-notmuch-tree-outline-setup (&optional prefix) - (define-key notmuch-tree-mode-map (kbd (or prefix "T")) - jao-notmuch-tree--prefix-map) - (define-key notmuch-tree-mode-map (kbd "TAB") #'outline-cycle) - (define-key notmuch-tree-mode-map (kbd "M-TAB") #'outline-cycle-buffer) - (add-hook 'notmuch-tree-mode-hook #'jao-notmuch-tree--mode-setup) - (advice-add 'notmuch-tree-insert-msg :before #'jao-notmuch-tree--msg-prefix)) - -(defun jao-notmuch-tree-next (thread &optional no-exit) - "Next message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next nil thread no-exit)) + (n (- (window-width) 2 (string-width subject) (string-width c))) + (subject (if (< n 0) (substring subject 0 n) subject)) + (n (if (< n 0) 2 (+ n 2)))) + (concat (when window-system " ") subject (make-string n ? ) c)))))) -(defun jao-notmuch-tree-next-thread (&optional exit) - "Next thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next nil t exit)) +(defun jao-notmuch-message-header-line (subject) + (if-let* ((cb (buffer-name (current-buffer))) + (tb (seq-find (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'notmuch-tree-mode) b))) + (buffer-list)))) + `((:eval (jao-notmuch--format-header-line ,(buffer-name tb) ,cb ,subject))) + (concat " " subject))) -(defun jao-notmuch-tree-previous (thread) - "Previous message or thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next t thread t)) +(defun jao-notmuch--format-lighter () + (when (derived-mode-p 'notmuch-tree-mode) + (let* ((n (jao-notmuch--message-counts (current-buffer))) + (nc (jao-notmuch--message-counts (current-buffer) t)) + (nc (append (or n '(0 0 0)) (or nc '(0 0 0))))) + (apply 'jao-notmuch--format-counts "" nc)))) -(defun jao-notmuch-tree-previous-thread (&optional exit) - "Previous thread in forest, taking care of thread visibility." - (interactive "P") - (jao-notmuch-tree--next t t exit)) - - -;;;; Updating the tree window after insertion - -(defun jao-notmuch--tree-sentinel (proc &rest _) - (when (eq (process-status proc) 'exit) - (jao-notmuch-tree-hide-others))) +(define-minor-mode jao-notmuch-thread-info-mode "" + :lighter (:eval (format " %s" (jao-notmuch--format-lighter)))) -(defun jao-notmuch-tree-setup (&optional prefix) - "Set up display of trees, with PREFIX key for outline commands." - (jao-notmuch-tree-outline-setup prefix) - (advice-add 'notmuch-tree-process-sentinel :after #'jao-notmuch--tree-sentinel)) - -;;;; Tagging +;;; tagging (defsubst jao-notmuch--has-tag (tag) (member tag (notmuch-tree-get-tags))) -(defun jao-notmuch-tag-jump-and-next (reverse) - (interactive "P") - (notmuch-tag-jump reverse) - (jao-notmuch-tree-next nil t)) - -(defun jao-notmuch-tree--tag (tags reverse whole-thread) +(defun jao-notmuch-tree--tag (tags reverse) (let ((c (notmuch-tag-change-list tags reverse))) - (if whole-thread (notmuch-tree-tag-thread c) (notmuch-tree-tag c)))) - -(defun jao-notmuch-tree--tag-and-next (tags reverse whole-thread) - (jao-notmuch-tree--tag tags reverse whole-thread) - (jao-notmuch-tree-next whole-thread t)) + (notmuch-tree-tag c))) + +(defun jao-notmuch-tree-tag-thread (tags reverse full) + (when full (notmuch-tree-thread-top)) + (let ((c (notmuch-tag-change-list tags reverse)) + (level (or (notmuch-tree-get-prop :level) 0)) + (go t)) + (while go + (notmuch-tree-tag c) + (forward-line) + (setq go (> (or (notmuch-tree-get-prop :level) 0) level))) + (when notmuch-tree-outline-mode + (ignore-errors (outline-show-branches)) + (notmuch-tree-outline-next)))) + +(defun jao-notmuch-tree--tag-and-next (tags reverse) + (jao-notmuch-tree--tag tags reverse) + (notmuch-tree-outline-next t)) (defun jao-notmuch-tree-toggle-delete () (interactive) (let ((undo (jao-notmuch--has-tag "deleted"))) - (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo nil))) + (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo))) -(defun jao-notmuch-tree-toggle-delete-thread () - (interactive) +(defun jao-notmuch-tree-toggle-delete-thread (full) + (interactive "P") (let ((undo (jao-notmuch--has-tag "deleted"))) - (jao-notmuch-tree--tag-and-next '("+deleted" "-new" "-unread") undo t))) + (jao-notmuch-tree-tag-thread '("+deleted" "-new" "-unread") undo full))) -(defun jao-notmuch-tree-read-thread (unread) +(defun jao-notmuch-tree-read-thread (full) (interactive "P") - (jao-notmuch-tree--tag-and-next '("-unread" "-new") unread t)) + (jao-notmuch-tree-tag-thread '("-unread" "-new") nil full)) (defun jao-notmuch-tree-toggle-flag () (interactive) (let ((tags (if (jao-notmuch--has-tag "flagged") '("-flagged") '("-unread" "-new" "-deleted" "+flagged")))) - (jao-notmuch-tree--tag-and-next tags nil nil))) + (jao-notmuch-tree--tag-and-next tags nil))) (defun jao-notmuch-tree-toggle-spam () (interactive) (let ((tags (if (jao-notmuch--has-tag "spam") '("-spam") '("-unread" "-new" "+spam")))) - (jao-notmuch-tree--tag-and-next tags nil nil))) + (jao-notmuch-tree--tag-and-next tags nil))) (defun jao-notmuch-tree-reset-tags () (interactive) (let ((tags (plist-get (notmuch-tree-get-message-properties) :orig-tags))) - (jao-notmuch-tree--tag tags nil nil) - (jao-notmuch-tree--next nil nil t t))) - - -;;;; Results formatters + (jao-notmuch-tree--tag tags nil))) + +;;; fcc +(defvar jao-notmuch-mua-reply-not-inherited + '("attachment" "sent" "new" "bigml" "jao" "trove")) + +(defun jao-notmuch-mua--fcc-dirs () + (let* ((otags (notmuch-show-get-tags)) + (trove (or (seq-some (lambda (x) (and (member x otags) x)) + '("hacking" "bills" "feeds" "jao")) + "jao")) + (tags (seq-difference otags jao-notmuch-mua-reply-not-inherited)) + (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) + (fcc (concat "trove/" trove " " tagstr " -new +sent +trove")) + (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) + (append fcc-dirs `((".*" . ,fcc))))) + +(defun jao-notmuch-mua--inherited-fcc () + (let* ((fn (notmuch-show-get-filename)) + (dest (and (string-match ".*/var/mail/\\(.+?\\)/.+" fn) + (match-string 1 fn))) + (tags (seq-difference (notmuch-show-get-tags) + '("attachment" "sent" "new" "flagged"))) + (tagstr (mapconcat (lambda (s) (concat "+" s)) tags " ")) + (fcc (concat dest " " tagstr " -new +sent +trove")) + (fcc-dirs (assoc-delete-all ".*" (copy-alist notmuch-fcc-dirs)))) + (append fcc-dirs `((".*" . ,fcc))))) + +(defun jao-notmuch-mua-new-reply (fun &rest args) + (let ((notmuch-fcc-dirs (and (not (notmuch-show-get-header :List-Id)) + (jao-notmuch-mua--inherited-fcc)))) + (apply fun args))) + +(advice-add 'notmuch-mua-new-reply :around #'jao-notmuch-mua-new-reply) + +;;; results formatters + +(defun jao-notmuch-cmp-tags (a b) + (or (> (length a) (length b)) (string-lessp a b))) (defun jao-notmuch-format-tags (fmt msg) (let ((ts (thread-last (notmuch-tree-format-field "tags" "%s" msg) (split-string) - (seq-sort-by #'length #'<)))) + ;; (seq-sort-by #'length #'<) + (seq-sort #'jao-notmuch-cmp-tags)))) (format-spec fmt `((?s . ,(mapconcat #'identity ts " ")))))) -(defun jao-notmuch-tree-and-subject (fmt msg) +(defun jao-notmuch-format-tree-and-subject (fmt msg) (let ((tr (notmuch-tree-format-field "tree" " %s" msg)) (sb (notmuch-tree-format-field "subject" " %s" msg))) (format-spec fmt `((?s . ,(concat tr sb)))))) -(defun jao-notmuch-msg-ticks (mails-rx msg) +(defun jao-notmuch-format-msg-ticks (mails-rx msg) (let ((headers (plist-get msg :headers))) (cond ((string-match-p mails-rx (or (plist-get headers :To) "")) (propertize " »" 'face 'notmuch-tree-match-tree-face)) diff --git a/attic/net/jao-proton-utils.el b/lib/net/jao-proton-utils.el index 012a2ff..62b97b3 100644 --- a/attic/net/jao-proton-utils.el +++ b/lib/net/jao-proton-utils.el @@ -1,6 +1,6 @@ ;; jao-proton-utils.el -- simple interaction with Proton mail and vpn -;; Copyright (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz +;; Copyright (c) 2018, 2019, 2020, 2023 Jose Antonio Ortega Ruiz ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -40,7 +40,17 @@ (unless (eq major-mode 'proton-bridge-mode) (proton-bridge-mode))) -(defvar proton-vpn-mode-map) +;;;###autoload +(defun proton-bridge-sendmail-setup () + "Configure message sending for local proton bridge." + (setq send-mail-function #'smtpmail-send-it) + (setq message-send-mail-function #'smtpmail-send-it) + (setq smtpmail-servers-requiring-authorization + (regexp-opt '("localhost" "127.0.0.1"))) + (setq smtpmail-auth-supported '(plain login)) + (setq smtpmail-smtp-user "mail@jao.io") + (setq smtpmail-smtp-server "localhost") + (setq smtpmail-smtp-service 1025)) (defvar jao-proton-vpn-font-lock-keywords '("\\[.+\\]")) diff --git a/lib/net/randomsig.el b/lib/net/randomsig.el index cb37694..05b95ab 100644 --- a/lib/net/randomsig.el +++ b/lib/net/randomsig.el @@ -1,6 +1,6 @@ ;;; randomsig.el --- insert a randomly selected signature -;; Copyright (C) 2001, 2002, 2013, 2020, 2021 Hans-Jrgen Ficker +;; Copyright (C) 2001, 2002, 2013, 2020, 2021, 2024 Hans-Jrgen Ficker ;; Emacs Lisp Archive Entry ;; Author: Hans-Juergen Ficker <hj@backmes.de> @@ -277,8 +277,11 @@ You probably want to have a newline at the end of it." (defun randomsig-prompt (&optional prompt) ;; Prompt for a signature file. (let ((files (randomsig-files-to-list randomsig-files))) - (completing-read (if prompt prompt "signature: ") - (mapcar 'list files) nil t nil randomsig-history (car files)))) + (if (cdr files) + (completing-read (if prompt prompt "signature: ") + (mapcar 'list files) nil t nil + randomsig-history (car files)) + (car files)))) (defun randomsig-read-signatures-to-buffer (buffer-name &optional files) ;; read the signatures into the signature buffer diff --git a/lib/net/signel.org b/lib/net/signel.org deleted file mode 100644 index 722069c..0000000 --- a/lib/net/signel.org +++ /dev/null @@ -1,546 +0,0 @@ -#+title: signel, a barebones signal chat on top of signal-cli -#+date: <2020-02-23 05:03> -#+filetags: emacs norss -#+PROPERTY: header-args :tangle yes :comments yes :results silent - -Unlike most chat systems in common use, [[https://signal.org][Signal]] lacks a decent emacs -client. All i could find was [[https://github.com/mrkrd/signal-msg][signal-msg]], which is able only to send -messages and has a readme that explicitly warns that its is /not/ a chat -application. Skimming over signal-msg's code i learnt about -[[https://github.com/AsamK/signal-cli][signal-cli]], a java-based daemon that knows how to send and receive -signal messages, and how to link to a nearby phone, or register new -users. And playing with it i saw that it can output its activities -formatted as JSON, and that offers (when run in daemon mode) a DBUS -service that can be used to send messages. - -Now, emacs knows how to run a process and capture its output handling -it to a filter function, and comes equipped with a JSON parser and -a set of built-in functions to talk to DBUS buses. - -So how about writing a simple Signal chat app for emacs? Let's call it -/signel/, and write it as [[https://gitlab.com/jaor/elibs/-/blob/master/net/signel.org][a blog post in literate org-mode]]. - -* Starting a process - -We are going to need a variable for our identity (telephone number), -and a list of contact names (until i discover how to get them directly -from signal-cli): - -#+begin_src emacs-lisp -(require 'cl-lib) - -(defvar signel-cli-user "+44744xxxxxx") -(defvar signel-contact-names '(("+447xxxxxxxx" . "john") - ("+346xxxxxxxx" . "anna"))) -#+end_src - -and a simple function to get a contact name given its telephone -number: - -#+begin_src emacs-lisp -(defun signel--contact-name (src) - (or (alist-get src signel-contact-names nil nil #'string-equal) src)) -#+end_src - -We are also going to need the path for our signal-cli executable - -#+begin_src emacs-lisp -(defvar signel-cli-exec "signal-cli") -#+end_src - -Starting the signal-cli process is easy: ~make-process~ provides all the -necessary bits. What we need is essentially calling - -#+begin_src shell -signal-cli -u +44744xxxxxx daemon --json -#+end_src - -associating to the process a buffer selected by the function -~signel--proc-buffer~ . While we are at it, we'll write also little -helpers for users of our API. - -#+begin_src emacs-lisp -(defun signel--proc-buffer () - (get-buffer-create "*signal-cli*")) - -(defun signel-signal-cli-buffer () - (get-buffer "*signal-cli*")) - -(defun signel-signal-cli-process () - (when-let ((proc (get-buffer-process (signel-signal-cli-buffer)))) - (and (process-live-p proc) proc))) -#+end_src - -#+begin_src emacs-lisp -(defun signel-start () - "Start the underlying signal-cli process if needed." - (interactive) - (if (signel-signal-cli-process) - (message "signal-cli is already running!") - (let ((b (signel--proc-buffer))) - (make-process :name "signal-cli" - :buffer b - :command `(,signel-cli-exec - "-u" - ,signel-cli-user - "daemon" "--json") - :filter #'signel--filter) - (message "Listening to signals!")))) -#+end_src - -* Parsing JSON - -We've told emacs to handle any ouput of the process to the function -~signel--filter~, which we're going to write next. This function will -receive the process object and its latest output as a string -representing a JSON object. Here's an example of the kind of outputs -that signal-cli emits: - -#+begin_src json :tangle no -{ - "envelope": { - "source": "+4473xxxxxxxx", - "sourceDevice": 1, - "relay": null, - "timestamp": 1582396178696, - "isReceipt": false, - "dataMessage": { - "timestamp": 1582396178696, - "message": "Hello there!", - "expiresInSeconds": 0, - "attachments": [], - "groupInfo": null - }, - "syncMessage": null, - "callMessage": null, - "receiptMessage": null - } -} -#+end_src - -Everything seems to be always inside ~envelope~, which contains objects -for the possible messages received. In the example above, we're -receiving a message from a /source/ contact. We can also receive -receipt messages, telling us whether our last message has been -received or read; e.g.: - -#+begin_src json :tangle no -{ - "envelope": { - "source": "+4473xxxxxxxx", - "sourceDevice": 1, - "relay": null, - "timestamp": 1582397117584, - "isReceipt": false, - "dataMessage": null, - "syncMessage": null, - "callMessage": null, - "receiptMessage": { - "when": 1582397117584, - "isDelivery": true, - "isRead": false, - "timestamps": [ - 1582397111524 - ] - } - } -} -#+end_src - -A bit confusingly, that delivery notification has a ~receiptMessage~, -but its ~isReceipt~ flag is set to ~false~. At other times, we get -~isReceipt~ but no ~receiptMessage~: - -#+begin_src json :tangle no -{ - "envelope": { - "source": "+346xxxxxxxx", - "sourceDevice": 1, - "relay": null, - "timestamp": 1582476539281, - "isReceipt": true, - "dataMessage": null, - "syncMessage": null, - "callMessage": null, - "receiptMessage": null - } -} -#+end_src - -It is very easy to parse JSON in emacs and extract signal-cli's -envelopes (and it's become faster in emacs 27, but the interface is a -bit different): - -#+begin_src emacs-lisp -(defun signel--parse-json (str) - (if (> emacs-major-version 26) - (json-parse-string str - :null-object nil - :false-object nil - :object-type 'alist - :array-type 'list) - (json-read-from-string str))) - -(defun signel--msg-contents (str) - (alist-get 'envelope (ignore-errors (signel--parse-json str)))) -#+end_src - -Here i am being old-school and opting to receive JSON dicitionaries as -alists (rather than hash maps, the default), and arrays as lists -rather than vectors just because lisps are lisps for a reason. I'm -also going to do some mild [[https://lispcast.com/nil-punning/][nil punning]], -hence the choice for null and false representations. - -Once the contents of the envelope is extracted, it's trivial (and -boring) to get into its components: - -#+begin_src emacs-lisp -(defun signel--msg-source (msg) (alist-get 'source msg)) - -(defun signel--msg-data (msg) - (alist-get 'message (alist-get 'dataMessage msg))) - -(defun signel--msg-timestamp (msg) - (if-let (msecs (alist-get 'timestamp msg)) - (format-time-string "%H:%M" (/ msecs 1000)) - "")) - -;; emacs 26 compat -(defun signel--not-false (x) - (and (not (eq :json-false x)) x)) - -(defun signel--msg-receipt (msg) - (alist-get 'receiptMessage msg)) - -(defun signel--msg-is-receipt (msg) - (signel--not-false (alist-get 'isReceipt msg))) - -(defun signel--msg-receipt-timestamp (msg) - (when-let (msecs (alist-get 'when (signel--msg-receipt msg))) - (format-time-string "%H:%M" (/ msecs 1000)))) - -(defun signel--msg-is-delivery (msg) - (when-let ((receipt (signel--msg-receipt msg))) - (signel--not-false (alist-get 'isDelivery msg)))) - -(defun signel--msg-is-read (msg) - (when-let ((receipt (signel--msg-receipt msg))) - (signel--not-false (alist-get 'isRead msg)))) -#+end_src - -* A process output filter - -We're almost ready to write our filter. It will: - -- For debugging purposes, insert the raw JSON string in the process - buffer. -- Parse the received JSON string and extract its envelope contents. -- Check wether it has a source and either message data or a receipt - timestamp. -- Dispatch to a helper function that will insert the data or - notification in a chat buffer. - -Or, in elisp: - -#+begin_src emacs-lisp -(defvar signel--line-buffer "") - -(defun signel--filter (proc str) - (signel--ordinary-insertion-filter proc str) - (let ((str (concat signel--line-buffer str))) - (if-let ((msg (signel--msg-contents str))) - (let ((source (signel--msg-source msg)) - (stamp (signel--msg-timestamp msg)) - (data (signel--msg-data msg)) - (rec-stamp (signel--msg-receipt-timestamp msg))) - (setq signel--line-buffer "") - (when source - (signel--update-chat-buffer source data stamp rec-stamp msg))) - (setq signel--line-buffer - (if (string-match-p ".*\n$" str) "" str))))) -#+end_src - -We've had to take care of the case when the filter receives input that -is not a complete JSON expression: in the case of signal-cli, that -only happens when we haven't seen yet an end of line. - -The function to insert the raw contents in the process buffer is -surprisingly hard to get right, but the emacs manual spells out a -reasonable implementation, which i just copied: - -#+begin_src emacs-lisp -(defun signel--ordinary-insertion-filter (proc string) - (when (and proc (buffer-live-p (process-buffer proc))) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - ;; Insert the text, advancing the process marker. - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc))))))) -#+end_src - -* It's not an emacs app if it doesn't have a new mode - -With that out of the way, we just have to insert our data in an -appropriate buffer. We are going to associate a separate buffer to -each /source/, using for that its name: - -#+begin_src emacs-lisp -(defvar-local signel-user nil) - -(defun signel--contact-buffer (source) - (let* ((name (format "*%s" (signel--contact-name source))) - (buffer (get-buffer name))) - (unless buffer - (setq buffer (get-buffer-create name)) - (with-current-buffer buffer - (signel-chat-mode) - (setq-local signel-user source) - (insert signel-prompt))) - buffer)) -#+end_src - -where, as is often the case in emacs, we are going to have a dedicated -major mode for chat buffers, called ~signel-chat-mode~. For now, let's -keep it really simple (for the record, this is essentially a copy of -what ERC does for its erc-mode): - -#+begin_src emacs-lisp -(defvar signel-prompt ": ") - -(define-derived-mode signel-chat-mode fundamental-mode "Signal" - "Major mode for Signal chats." - (when (boundp 'next-line-add-newlines) - (set (make-local-variable 'next-line-add-newlines) nil)) - (setq line-move-ignore-invisible t) - (set (make-local-variable 'paragraph-separate) - (concat "\C-l\\|\\(^" (regexp-quote signel-prompt) "\\)")) - (set (make-local-variable 'paragraph-start) - (concat "\\(" (regexp-quote signel-prompt) "\\)")) - (setq-local completion-ignore-case t)) -#+end_src - -Note how, in ~signel--contact-buffer~, we're storing the user identity -associated with the buffer (its /source/) in a buffer-local variable -named ~signel-user~ that is set /after/ enabling ~signel-chat-mode~: order -here matters because the major mode activation cleans up the values of -any local variables previously set (i always forget that!). - -* And a customization group - -We're going to need a couple of new faces for the different parts of -inserted messages, so we'll take the chance to be tidy and introduce a -customization group: - -#+begin_src emacs-lisp -(defgroup signel nil "Signel") - -(defface signel-contact '((t :weight bold)) - "Face for contact names." - :group 'signel) - -(defface signel-timestamp '((t :foreground "grey70")) - "Face for timestamp names." - :group 'signel) - -(defface signel-notice '((t :inherit signel-timestamp)) - "Face for delivery notices." - :group 'signel) - -(defface signel-prompt '((t :weight bold)) - "Face for the input prompt marker." - :group 'signel) - -(defface signel-user '((t :foreground "orangered")) - "Face for sent messages." - :group 'signel) - -(defface signel-notification '((t :foreground "burlywood")) - "Face for notifications shown by tracking, when available." - :group 'signel) - -#+end_src - - -* Displaying incoming messages - -We have now almost all the ingredients to write -~signel--update-chat-buffer~, the function that inserts the received -message data into the chat buffer. Let's define a few little -functions to format those parts: - -#+begin_src emacs-lisp -(defun signel--contact (name) - (propertize name 'face 'signel-contact)) - -(defun signel--timestamp (&rest p) - (propertize (apply #'concat p) 'face 'signel-timestamp)) - -(defun signel--notice (notice) - (propertize notice 'face 'signel-notice)) - -(defun signel--insert-prompt () - (let ((inhibit-read-only t) - (p (point))) - (insert signel-prompt) - (set-text-properties p (- (point) 1) - '(face signel-prompt - read-only t front-sticky t rear-sticky t)))) - -(defun signel--delete-prompt () - (when (looking-at-p (regexp-quote signel-prompt)) - (let ((inhibit-read-only t)) - (delete-char (length signel-prompt))))) - -(defun signel--delete-last-prompt () - (goto-char (point-max)) - (when (re-search-backward (concat "^" (regexp-quote signel-prompt))) - (signel--delete-prompt))) - -#+end_src - -With that, we're finally ready to insert messages in our signel chat -buffers: - -#+begin_src emacs-lisp -(defcustom signel-report-deliveries nil - "Whether to show message delivery notices." - :group 'signel - :type 'boolean) - -(defcustom signel-report-read t - "Whether to show message read notices." - :group 'signel - :type 'boolean) - -(defun signel--prompt-and-notify () - (signel--insert-prompt) - (when (fboundp 'tracking-add-buffer) - (tracking-add-buffer (current-buffer) '(signel-notification)))) - -(defun signel--needs-insert-p (data stamp rec-stamp msg) - (or data - (and (or rec-stamp stamp) - (not (string= source signel-cli-user)) - (or signel-report-deliveries - (and signel-report-read (signel--msg-is-read msg)))))) - -(defun signel--update-chat-buffer (source data stamp rec-stamp msg) - (when (signel--needs-insert-p data stamp rec-stamp msg) - (when-let ((b (signel--contact-buffer source))) - (with-current-buffer b - (signel--delete-last-prompt) - (if data - (let ((p (point))) - (insert (signel--timestamp "[" stamp "] ") - (signel--contact (signel--contact-name source)) - signel-prompt - data - "\n") - (fill-region p (point))) - (let ((is-read (signel--msg-is-read msg))) - (insert (signel--timestamp "*" (or rec-stamp stamp) "* ") - (signel--notice (if is-read "(read)" "(delivered)")) - "\n"))) - (signel--prompt-and-notify) - (end-of-line))))) -#+end_src - -There are some rough edges in the above implementation that must be -polished should signel ever be released in the wild. For one, proper -handling of timestamps and their formats. And of course notifications -should be much more customizable (here i'm using [[https://github.com/jorgenschaefer/circe/blob/master/tracking.el][Circe's tracking.el]] -if available). - -* Sending messages: the DBUS interface - -With that, we're going to receive and display messages and simple -receipts, and i'm sure that we will feel the urge to answer some of -them. As mentioned above, signal-cli let's us send messages via its -[[https://github.com/AsamK/signal-cli/wiki/DBus-service][DBUS interface]]. -In a nutshell, if you want to send ~MESSAGETEXT~ to a -~RECIPIENT~ you'd invoke something like: - -#+begin_src shell :tangle no -dbus-send --session --type=method_call \ - --dest="org.asamk.Signal" \ - /org/asamk/Signal \ - org.asamk.Signal.sendMessage \ - string:MESSAGETEXT array:string: string:RECIPIENT -#+end_src - -That is, call the method ~sendMessage~ of the corresponding service -interface with three arguments (the second one empty). Using emacs' -dbus libray one can write the above as: - -#+begin_src emacs-lisp -(defun signel--send-message (user msg) - (dbus-call-method :session "org.asamk.Signal" "/org/asamk/Signal" - "org.asamk.Signal" "sendMessage" - :string msg - '(:array) - :string user)) -#+end_src - -The only complicated bit is being careful with the specification of -the types of the method arguments: if one gets them wrong, DBUS will -simply complain and say that the method is not defined, which was -confusing me at first (but of course makes sense because DBUS allows -overloading method names, so the full method spec must include its -signature). - -We want to read whatever our user writes after the last prompt and -send it via the little helper above. Here's our interactive command -for that: - -#+begin_src emacs-lisp -(defun signel-send () - "Read text inserted in the current buffer after the last prompt and send it. - -The recipient of the message is looked up in a local variable set -when the buffer was created." - (interactive) - (goto-char (point-max)) - (beginning-of-line) - (let* ((p (point)) - (plen (length signel-prompt)) - (msg (buffer-substring (+ p plen) (point-max)))) - (signel--delete-prompt) - (signel--send-message signel-user msg) - (insert (signel--timestamp (format-time-string "(%H:%M) "))) - (fill-region p (point-max)) - (goto-char (point-max)) - (set-text-properties p (point) '(face signel-user)) - (insert "\n") - (signel--insert-prompt))) -#+end_src - -and we can bind it to the return key in signal chat buffers: - -#+begin_src emacs-lisp -(define-key signel-chat-mode-map "\C-m" #'signel-send) -#+end_src - -And we are going sometimes to want to talk to contacts that don't have -yet said anything and have, therefore, no associated chat buffer: - -#+begin_src emacs-lisp -(defun signel-query (contact) - "Start a conversation with a signal contact." - (interactive (list (completing-read "Signal to: " - (mapcar #'cdr-safe signel-contact-names)))) - (let ((phone (alist-get contact - (cl-pairlis (mapcar #'cdr signel-contact-names) - (mapcar #'car signel-contact-names)) - nil nil #'string-equal))) - (when (not phone) - (error "Unknown contact %s" contact)) - (pop-to-buffer (signel--contact-buffer phone)))) -#+end_src - -There are of course lots of rough edges and missing functionality in -this incipient signel, but it's already usable and a nice -demonstration of how easy it is to get the ball rolling in this lisp -machine of ours! diff --git a/lib/skels/jao-skel-haskell.el b/lib/skels/jao-skel-haskell.el index 01a9936..0c3c17d 100644 --- a/lib/skels/jao-skel-haskell.el +++ b/lib/skels/jao-skel-haskell.el @@ -1,4 +1,5 @@ -;;; jao-skel-haskell.el --- skeleton for haskell source files -*- lexical-binding: t; -*- +;; jao-skel-haskell.el --- skeleton for haskell -*- lexical-binding: t; -*- + ;; Copyright (C) 2003, 2004, 2005, 2009, 2010, 2012, 2022 Jose A Ortega Ruiz ;; Author: Jose A Ortega Ruiz <jao@member.fsf.org> @@ -19,31 +20,23 @@ ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Commentary: - -;; - ;;; Code: (require 'jao-skel) (require 'jao-compilation) +(require 'haskell-mode nil t) -;;; Auxiliar -(defun jao-skel--read-haskell-module () - (let* ((ddir (jao-compilation-root)) - (mbase (and ddir (concat (replace-regexp-in-string "/" "." ddir) - "."))) - (m (read-string "Module prefix (empty for no module): " - (concat (or mbase "") (jao-skel-basename))))) - (or m ""))) +(defun jao-skel-haskell--guess-module () + (if (fboundp 'haskell-guess-module-name) + (haskell-guess-module-name) + (read-string "Module: " (jao-skel-basename)))) (defconst jao-skel--haskell-line (make-string 78 ?-)) -;;; Skeletons (define-skeleton jao-skel-haskell-file "Haskell hs file header" "Brief description: " - '(setq v (jao-skel--read-haskell-module)) + '(setq v (jao-skel-haskell--guess-module)) jao-skel--haskell-line \n "-- |" \n "-- Module: " v \n @@ -63,7 +56,6 @@ "module " v " where " \n \n \n) (jao-skel-install "\\.hs\\'" 'jao-skel-haskell-file) -;; (jao-skel-install "\\.lhs\\'" 'jao-skel-lit-haskell-file) (provide 'jao-skel-haskell) diff --git a/lib/themes/jao-light-term-theme.el b/lib/themes/jao-light-term-theme.el new file mode 100644 index 0000000..ccd6a3f --- /dev/null +++ b/lib/themes/jao-light-term-theme.el @@ -0,0 +1,121 @@ +;;; jao-light-term-theme.el --- a light theme -*- lexical-binding: t; -*- + +;; Author: jao <mail@jao.io> +;; Keywords: themes + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(jao-define-custom-theme jao-light-term + (:names (bg-lightest "gray98") + (bg-light "gray95") + + (light-gray "gray80") + + (black "black") + (dark-gray "gray30") + (fg-light "gray40") + + ;; (hl "#f2f2f2") + (hl "ivory2") + (dimm "lemonchiffon4") + + (warning "orange4") + (red "burlywood4") + (blue "#023770") + (green "#005555") + (lightgreen "darkgreen") + (yellow "lightyellow")) + (:face-size 9) + (:face-family "DejaVu Sans Mono") + (:bold-weight 'bold) + (:palette (fg "#000000") + (bg "#ffffff") + (box "gray80") + (hilite (c nil hl)) + (link (c green) nbf nul) + (visited-link (c green)) + (tab-sel (~ mode-line)) + (tab-unsel (~ mode-line-inactive)) + (comment (c fg-light) it) + (keyword (c blue) bf) + (type (c blue) nbf) + (function (c green)) + (variable-name (c black)) + (constant (c dark-gray)) + (string (c blue) nit) + (warning (c warning)) + (error (c red) bf) + (dimm (c dimm)) + (gnus-mail (c "black")) + (gnus-news (c "black")) + (outline (c "black") bf) + (outline-1 (c green) nbf nul ex) + (outline-2 (c blue) nbf) + (outline-3 (c lightgreen) nbf) + (outline-4 (c blue) nul nbf) + (outline-5 (c blue) nul nbf) + (f00 (c green)) + (f01 (c blue)) + (f02 (c dark-gray)) + (f10 (p f00)) + (f11 (p f01)) + (f12 (p f02))) + (:x-faces (button (c blue bg-lightest)) + (compilation-info (c "#223142" nil) nbf) + (completions-group-separator (c nil ni) (st "grey80")) + (corfu-default (~ default) (c "black" "grey95")) + (corfu-bar (c nil "grey80")) ;; moving part of the bar + (corfu-border (~ corfu-background)) ;; background of the bar + (corfu-current (c "black" "grey95") nbf nit (ul "grey70")) + (cursor (c "sienna3" "sienna3")) + (diff-hl-margin-change (c "lightcyan2" nil)) + (diff-hl-margin-insert (c "honeydew2" nil)) + (diff-hl-margin-delete (c "wheat1" nil)) + (eww-form-text (p hilite)) + (fill-column-indicator (c "grey80")) + (fringe (c "grey70" nil)) + (gnus-button (c blue)) + (gnus-cite-1 (c "darkslategray" nil)) + (gnus-cite-2 (c "slate gray" nil)) + (gnus-cite-3 (c "slate gray" nil)) + (gnus-cite-4 (c "slate gray" nil)) + (gnus-header-name (c fg-light)) + (gnus-summary-selected (c green) nbf) + (gnus-summary-cancelled (c "sienna3" nil) st) + (header-line (c dark-gray bg-lightest) + :box (:line-width 1 :color "grey90")) + (magit-diff-context-highlight (c nil hl) ex) + (magit-diff-hunk-heading-highlight (c nil hl) it bf) + (mode-line (c "grey20" "gray90") nbf) + (mode-line-inactive (c "grey40" "gray95")) + (mode-line-buffer-id (~ default) (c dark-blue-2 nil) nit) + (mode-line-emphasis (c green nil)) + (mode-line-highlight (c green nil)) + (org-link (p link) (ul "grey80")) + (scroll-bar (c "grey90" nil)) + (show-paren-match (c nil "grey85")) + (shr-text (c nil nil)) + (shr-link (~ link) (ul light-gray)) + (shr-code (c blue nil)) + (success (c green)) + (vertical-border (c "grey70" nil)) + (vertico-current (c nil yellow) nul ext) + (widget-button (c blue nil) nit nul) + (widget-field (c nil bg-light) nit nul) + (whitespace-tag (p hilite)))) + +;; (enable-theme 'jao-light-term) +;; (jao-mode-line-adjust-faces) + +(provide 'jao-light-term-theme) diff --git a/lib/themes/jao-light-theme.el b/lib/themes/jao-light-theme.el index bd3fcdf..659b6bb 100644 --- a/lib/themes/jao-light-theme.el +++ b/lib/themes/jao-light-theme.el @@ -16,8 +16,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. -(defvar jao-theme-light-bold (if (> emacs-major-version 28) 'medium 'semibold)) - (jao-define-custom-theme jao-light (:names (bg-lightest "gray98") (bg-light "gray95") @@ -31,21 +29,22 @@ (hl "#f2f2f2") (dimm "lemonchiffon4") - (search "#e8e800") - (search2 "#ffffb4") - (warning "orange4") (red "burlywood4") (blue "#023770") - (green "#005555")) + (pale-blue "honeydew3") + (green "#005555") + (lightgreen "darkgreen") + (yellow "lightyellow")) (:face-size 9) - (:face-family "Fira Code") - (:bold-weight jao-theme-light-bold) + ;; (:face-family "DejaVu Sans Mono") + (:face-family "Hack") + (:bold-weight 'semibold) (:palette (fg "black") (bg "white") (box "gray80") - (button (c fg-light bg-lightest) (ul light-gray)) (hilite (c nil hl)) + (button (c fg-light bg-lightest) (ul light-gray)) (link (c green) nbf (ul light-gray)) (visited-link (ul light-gray) nbf) (tab-sel (~ mode-line)) @@ -81,9 +80,12 @@ (corfu-border (~ corfu-background)) ;; background of the bar (corfu-current (c "black" "grey95") nbf nit (ul "grey70")) (cursor (c "sienna3" "sienna3")) - (diff-hl-change (c "white" pale-blue)) - (diff-hl-insert (c "white" "honeydew2")) + (diff-hl-change (c "white" "honeydew2")) + (diff-hl-insert (c "white" "lemonchiffon2")) (diff-hl-delete (c "white" "wheat1")) + (diff-hl-margin-change (c pale-blue)) + (diff-hl-margin-insert (c pale-blue)) + (diff-hl-margin-delete (c "wheat1")) (fill-column-indicator (c "grey80")) (fringe (c "grey70" nil)) (gnus-button (c blue)) @@ -96,23 +98,26 @@ (gnus-summary-cancelled (c "sienna3" nil) st) (header-line (c dark-gray bg-lightest) :box (:line-width 1 :color "grey90")) - (magit-diff-context-highlight (c nil hl) ex) + (magit-diff-context-highlight (c nil yellow) ex) (magit-diff-hunk-heading-highlight (c nil hl) it bf) - (mode-line (c "grey30" bg-light) - :box (:line-width -1 :color "grey90")) - (mode-line-inactive (c "grey40" "white") - :box (:line-width -1 :color "grey90")) - (mode-line-buffer-id (~ default) (c dark-blue-2 nil) nit) + (message-header-subject (p warning) nbf) + (mode-line (c "grey20") :box (:line-width 1 :color "grey80")) + (mode-line-inactive + (c "grey40" bg-light) :box (:line-width 1 :color "grey80")) + (mode-line-buffer-id (~ default) (c nil nil) nit) (mode-line-emphasis (c green nil)) (mode-line-highlight (c green nil)) (org-link (p link) (ul "grey80")) + (tab-bar (~ header-line) :family "Source Code Pro") (scroll-bar (c "grey80" nil)) (show-paren-match (c nil "grey85")) (shr-text (c nil nil)) (shr-link (~ link) (ul light-gray)) (shr-code (c blue nil)) (success (c green)) + (variable-pitch :family "Iosevka Etoile" :height 90) (vertical-border (c "grey70" nil)) + (vterm-color-yellow (c "darkgoldenrod4" yellow)) (widget-button (~ default) nit (ul "grey80")))) ;; (enable-theme 'jao-light) diff --git a/lib/themes/jao-themes.el b/lib/themes/jao-themes.el index 2c182f6..f529842 100644 --- a/lib/themes/jao-themes.el +++ b/lib/themes/jao-themes.el @@ -21,8 +21,8 @@ (require 'ansi-color) ;;; palette -(defvar jao-themes-default-face "Hack-9") -(defvar jao-themes--face-family "Hack") +(defvar jao-themes-default-face "DejaVu Sans Mono-9") +(defvar jao-themes--face-family "DejaVu Sans Mono") (defvar jao-themes--fg "black") (defvar jao-themes--bg "white") (defvar jao-themes--box "grey75") @@ -191,6 +191,8 @@ (nth clr jao-themes--default-cidxs) (format "color-%s" clr))) ((and (symbolp clr) (cadr (assoc clr *jao-themes--color-names*)))) + ((equal clr 'dfg) jao-themes--fg) + ((equal clr 'dbg) jao-themes--bg) (t 'unspecified))) (defun jao-themes--parse-face-sym (s) @@ -300,7 +302,8 @@ (jao-themes-f10 (p f10)) (jao-themes-f11 (p f11)) (jao-themes-f12 (p f12))) - `((ansi-color-bright-blue (c "steelblue3" "steelblue3")) + `((ansi-color-bold bf) + (ansi-color-bright-blue (c "steelblue3" "steelblue3")) (ansi-color-bright-cyan (c "cyan3" "cyan3")) (ansi-color-bright-green (c "darkseagreen3" "darkseagreen3")) (ansi-color-bright-magenta (c "lightpink4" "lightpink4")) @@ -311,23 +314,9 @@ (ansi-color-green (c "darkseagreen4" "darkseagreen4")) (ansi-color-magenta (c "lightpink3" "lightpink3")) (ansi-color-yellow (c "lightgoldenrod3" "lightgoldenrod3")) - (aw-background-face (p dimm)) - (aw-leading-char-face (~ error) bf :height 3.0) - (awesome-tray-module-awesome-tab-face (p f00)) - (awesome-tray-module-battery-face (p f00)) - (awesome-tray-module-battery-face (p f00)) - (awesome-tray-module-buffer-name-face (p f11)) - (awesome-tray-module-circe-face (p f00)) - (awesome-tray-module-date-face (p f00)) - (awesome-tray-module-date-face (p f01)) - (awesome-tray-module-evil-face (p f00)) - (awesome-tray-module-file-path-face (p f00)) - (awesome-tray-module-git-face (p f10)) - (awesome-tray-module-last-command-face (p f00)) - (awesome-tray-module-location-face (p f00)) - (awesome-tray-module-mode-name-face (p f00)) - (awesome-tray-module-parent-dir-face (p f00)) - (awesome-tray-module-rvm-face (p f00))) + (avy-lead-face (c "red" "grey90") bf :height 1.0) + (avy-lead-face-0 (~ avy-lead-face) bf) + (avy-lead-face-1 (~ avy-lead-face))) `((bbdb-company) (bbdb-field-name bf) (bbdb-field-value (~ default)) @@ -505,6 +494,10 @@ (embark-verbose-indicator-documentation it) (embark-verbose-indicator-title (p f00)) (embark-verbose-indicator-shadowed (p dimm)) + (ement-room-reactions-key (~ ement-room-reactions)) + (ement-room-self-face (p warning) nb) + (ement-room-timestamp-header (~ header-line) :height 1.0 nb) + (ement-room-user-face (~ default)) (emms-browser-album-face (p f00) :height 1.0) (emms-browser-artist-face (p f01) :height 1.0) (emms-browser-composer-face (p f02) :height 1.0) @@ -604,6 +597,10 @@ (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-label bx) (fringe (p dimm)) (fuel-font-lock-debug-error (p error) nul) @@ -816,7 +813,7 @@ (lui-button-face (p link)) (lui-highlight-face (p warning)) (lui-time-stamp-face (p dimm)) - (lui-track-bar (p dimm) :height 0.2 nul nil ex)) + (lui-track-bar (p dimm) nul nil ex)) `((magit-branch (p f00)) (magit-cherry-equivalent (p warning)) (magit-diff-add (~ diff-added)) @@ -837,6 +834,7 @@ (magit-log-head-label-tags (p warning) nbf) (magit-log-graph (p f11)) (magit-log-tag-label (p keyword)) + (magit-process-ok (c nil nil)) (magit-section-highlight (p hilite) ex) (magit-section-heading (~ outline-1)) (magit-section-secondary-heading (~ outline-2)) @@ -940,7 +938,7 @@ (org-ellipsis (p dimm)) (org-formula (p f02)) (org-headline-done (p dimm)) - (org-hide (c dbg dfg)) + (org-hide (c dbg nil)) (org-latex-and-export-specials (~ default)) (org-level-1 (~ outline-1)) (org-level-2 (~ outline-2)) @@ -963,7 +961,7 @@ (org-table (p f01)) (org-tag (p dimm) nbf) (org-target ul) - (org-time-grid dfg dbg) + (org-time-grid (c nil nil)) (org-todo nbf niv (p error)) (org-upcoming-deadline (p f02)) (org-verbatim (p hilite)) @@ -976,14 +974,14 @@ (outline-6 nbf ul (p outline-6)) (outline-7 nbf ul (p outline-7)) (outline-8 nbf ul (p outline-8)) - (outline-minor-1 bf (~ outline-1) (c nil "grey95") ex) - (outline-minor-2 bf (~ outline-2) (c nil "grey95") ex) - (outline-minor-3 bf (~ outline-3) (c nil "grey95") ex) - (outline-minor-4 bf (~ outline-4) (c nil "grey95") ex) - (outline-minor-5 bf (~ outline-5) (c nil "grey95") ex) - (outline-minor-6 bf (~ outline-6) (c nil "grey95") ex) - (outline-minor-7 bf (~ outline-7) (c nil "grey95") ex) - (outline-minor-8 bf (~ outline-8) (c nil "grey95") ex)) + (outline-minor-1 nbf (~ outline-1) ex) + (outline-minor-2 nbf (~ outline-2) ex) + (outline-minor-3 nbf (~ outline-3) ex) + (outline-minor-4 nbf (~ outline-4) ex) + (outline-minor-5 nbf (~ outline-5) ex) + (outline-minor-6 nbf (~ outline-6) ex) + (outline-minor-7 nbf (~ outline-7) ex) + (outline-minor-8 nbf (~ outline-8) ex)) `((powerline-active1 (~ mode-line)) (powerline-active2 (~ mode-line-inactive)) (powerline-inactive1 (~ mode-line-inactive)) @@ -1016,6 +1014,7 @@ (rst-level-8-face (~ outline-8))) `((secondary-selection (p hilite) ex) (separator-line (~ default) (st "grey85")) + (sh-heredoc (~ font-lock-doc-face)) (sh-quoted-exec (p f00)) (shortdoc-heading (p outline-1) nul) (shortdoc-section (p outline-2)) @@ -1080,18 +1079,30 @@ (success (p success)) (sunshine-forecast-date-face (~ default)) (sunshine-forecast-day-divider-face (p dimm)) - (sunshine-forecast-headline-face (~ header-line))) - `((telega-button (~ button)) + (sunshine-forecast-headline-face (~ header-line)) + (symbol-overlay-face-1 (c nil "brown1")) + (symbol-overlay-face-2 (c nil "lightsalmon1")) + (symbol-overlay-face-3 (c nil "tomato1")) + (symbol-overlay-face-4 (c nil "coral")) + (symbol-overlay-face-5 (~ symbol-overlay-face-1)) + (symbol-overlay-face-6 (~ symbol-overlay-face-2)) + (symbol-overlay-face-7 (~ symbol-overlay-face-3)) + (symbol-overlay-face-8 (~ symbol-overlay-face-4))) + `((tab-bar (~ header-line)) + (telega-button (~ button)) (telega-button-active (~ button)) + (telega-entity-type-spoiler (c dfg dbg)) (telega-msg-heading (p f00)) (telega-msg-self-title (p f01)) (telega-root-heading (p hilite)) (textsec-suspicious (~ default) bx) - (term (~ default)) + (term (c dfg dbg)) (tool-bar (~ default)) (tooltip :family ,jao-themes--face-family (c nil "lightyellow") :height 0.9) (trailing-whitespace (p error)) + (transient-key-exit (p error) bf) + (transient-key-stay (p f00) bf) (treemacs-root-face nul bf :scale 1.1) (twittering-timeline-footer-face (~ header-line)) (twittering-timeline-header-face (~ header-line)) diff --git a/notmuch.org b/notmuch.org deleted file mode 100644 index 89b30fb..0000000 --- a/notmuch.org +++ /dev/null @@ -1,655 +0,0 @@ -#+property: header-args:emacs-lisp :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" :tangle-mode (identity #o644) -#+title: notmuch configuration - -* minibuffer - #+begin_src emacs-lisp - (defvar jao-notmuch-minibuffer-string "") - - (defvar jao-notmuch-minibuffer-queries - '((:name "" :query "tag:new and not tag:draft" :face jao-themes-f00) - (:name "B" :query "tag:new and tag:bigml and tag:inbox" :face default) - (:name "b" :query "tag:new and tag:bigml and tag:bugs" - :face jao-themes-error) - (:name "S" :query "tag:new and tag:bigml and tag:support" :face default) - (:name "W" - :query "tag:new and tag:bigml and not tag:\"/support|bugs|inbox/\"" - :face default) - (:name "I" - :query "tag:new and tag:jao and tag:inbox" - :face jao-themes-warning) - (:name "J" - :query "tag:new and tag:jao and not tag:\"/local|hacking|draft|inbox/\"" - :face default) - (:name "H" :query "tag:new and tag:hacking and not tag:\"/emacs/\"") - (:name "E" :query "tag:new and tag:\"/emacs/\"") - (:name "l" :query "tag:new and tag:local") - (:name "F" :query "tag:new and tag:feeds and not tag:\"/emacs/\""))) - - (defun jao-notmuch-notify () - (let ((cnts (notmuch-hello-query-counts jao-notmuch-minibuffer-queries))) - (setq jao-notmuch-minibuffer-string - (mapconcat (lambda (c) - (propertize (format "%s%s" - (plist-get c :name) - (plist-get c :count)) - 'face (or (plist-get c :face) - 'jao-themes-dimm))) - cnts - " ")) - (jao-minibuffer-refresh))) - - (when jao-notmuch-enabled - (jao-minibuffer-add-variable 'jao-notmuch-minibuffer-string -20)) - #+end_src -* saved searches - #+begin_src emacs-lisp - (defvar jao-notmuch--new "tag:\"/^(unread|new)$/\"") - (defvar jao-notmuch--newa (concat jao-notmuch--new " AND ")) - - (defun jao-notmuch--q (d0 d1 &optional k qs st) - (let ((q (or (when qs (mapconcat #'identity qs " AND ")) - (concat jao-notmuch--newa - (mapconcat (lambda (d) (when d (concat "tag:" d))) - (list d0 d1) " AND "))))) - (list :name (concat d0 (when (and d1 (not (string= "" d1))) "/") d1) - :key k :query q :search-type (or st 'tree) - :sort-order 'oldest-first))) - - (defun jao-notmuch--qn (d0 d1 k qs &optional st) - (jao-notmuch--q d0 d1 k (cons jao-notmuch--new qs) st)) - - (defun jao-notmuch--sq (tag &optional k d0 d1) - (jao-notmuch--qn (or d0 "feeds") (or d1 tag) k (list (concat "tag:" tag)))) - - (defvar jao-notmuch--shared-tags - '("new" "unread" "flagged" "signed" "sent" "attachment" "forwarded" - "encrypted" "gmane" "gnus" "feeds" "rss" "mce" "trove" "prog" "emacs")) - - (defun jao-notmuch--subtags (tag &rest excl) - (let* ((cmd (concat "notmuch search --output=tags tag:" tag)) - (ts (split-string (shell-command-to-string cmd)))) - (seq-difference ts (append jao-notmuch--shared-tags (cons tag excl))))) - - (defvar jao-notmuch-feed-searches - (append (mapcar #'jao-notmuch--sq '("news" - "fun" - "words" - "computers" - "mailutils" - "notmuch" - "lobsters" - "clojure" - "haskell" - "idris" - "pharo" - "lisp" - "scheme" - "xmobar" - "geiser" - "philosophy" - "math" - "physics" - "sci" - "gr-qc" - "quant-ph")) - `(,(jao-notmuch--qn "feeds" "prog" "fp" - '("tag:prog" "not tag:\"/emacs/\""))))) - - (defvar jao-notmuch-bigml-searches - `(,(jao-notmuch--q "bigml" "inbox" "bi") - ,(jao-notmuch--q "bigml" "support" "bs") - ,(jao-notmuch--q "bigml" "bugs" "bb") - ,(jao-notmuch--q "bigml" "drivel" "bd") - ,(jao-notmuch--q "bigml" "lists" "bl"))) - - (defvar jao-notmuch-inbox-searches - `(,(jao-notmuch--q "jao" "inbox" "ji") - ,(jao-notmuch--q "jao" "bills" "jb") - ,(jao-notmuch--q "jao" "drivel" "jd") - ,(jao-notmuch--q "jao" "mdk" "jm") - ,(jao-notmuch--qn "jao" "hacking" "jh" - '("tag:hacking" "not tag:\"/emacs/\"")) - ,(jao-notmuch--qn "jao" "local" "jl" '("tag:local")))) - - (defvar jao-notmuch-mark-searches - `(,(jao-notmuch--q "jao" "drafts" "d" '("tag:draft")) - ,(jao-notmuch--q "bml" "flagged" "rb" '("tag:flagged" "tag:bigml")) - ,(jao-notmuch--q "jao" "flagged" "rj" '("tag:flagged" "tag:jao")) - ,(jao-notmuch--q "feeds" "flagged" "rf" '("tag:flagged" "tag:feeds")))) - - (defvar jao-notmuch-emacs-searches - `(,(jao-notmuch--sq "emacs" "ee" "emacs" "feeds") - ,(jao-notmuch--sq "emacs-github" "eg" "emacs" "github") - ,(jao-notmuch--sq "emacs-devel" "ed" "emacs" "devel") - ,(jao-notmuch--sq "emacs-bugs" "eb" "emacs" "bugs") - ,(jao-notmuch--sq "emacs-diffs" "ec" "emacs" "diffs") - ,(jao-notmuch--sq "emacs-orgmode" "eo" "emacs" "org"))) - - (setq notmuch-saved-searches - (append jao-notmuch-inbox-searches - jao-notmuch-bigml-searches - jao-notmuch-mark-searches - jao-notmuch-feed-searches - jao-notmuch-emacs-searches)) - - (defvar jao-notmuch-dynamic-searches - `(,(jao-notmuch--q "bml" "today" "tb" '("tag:bigml" "date:24h..")) - ,(jao-notmuch--q "jao" "today" "tj" - '("tag:jao" "date:24h.." - "not tag:\"/(feeds|spam|local)/\"")))) - - (defvar jao-notmuch-new-searches - `(,(jao-notmuch--q "new" nil "nn" '("tag:new" "not tag:draft")) - ,(jao-notmuch--q "unread" nil "nu" '("tag:unread")) - (:query "*" :name "messages"))) - - (defun jao-notmuch-tree-widen-search () - (interactive) - (when-let ((query (notmuch-tree-get-query))) - (let ((notmuch-show-process-crypto (notmuch-tree--message-process-crypto))) - (notmuch-tree-close-message-window) - (notmuch-tree (string-replace jao-notmuch--newa "" query))))) - - (defun jao-notmuch-widen-searches (searches &optional extra) - (mapcar (lambda (s) - (let* ((q (plist-get s :query)) - (qs (string-replace jao-notmuch--newa "" q))) - (plist-put (copy-sequence s) :query (concat qs extra)))) - searches)) - - (defvar jao-notmuch-widened-searches - (jao-notmuch-widen-searches notmuch-saved-searches)) - - (defvar jao-notmuch-flagged-searches - (let ((s (seq-difference notmuch-saved-searches - jao-notmuch-mark-searches))) - (jao-notmuch-widen-searches s " AND tag:flagged"))) - - (defun jao-notmuch-jump-search (&optional widen) - (interactive "P") - (let ((notmuch-saved-searches - (if widen jao-notmuch-widened-searches notmuch-saved-searches))) - (notmuch-jump-search))) - - #+end_src -* tags - #+begin_src emacs-lisp - (setq notmuch-archive-tags '("+trove" "-new" "-inbox") - notmuch-show-mark-read-tags '("-new" "-unread") - notmuch-tag-formats - (let ((d `(:foreground ,(face-attribute 'jao-themes-dimm :foreground))) - (e `(:foreground ,(face-attribute 'jao-themes-error :foreground) - :weight bold))) - `(("unread") - ("signed") - ("new" "N") - ("replied" "↩" (propertize tag 'face '(:family "Fira Code"))) - ("sent" "S") - ("attachment" "📎") - ("deleted" "🗙" (propertize tag 'face '(:underline nil ,@e))) - ("flagged" "!" (propertize tag 'face ',e)) - ("jao" "j") - ("bigml" "b") - ("feeds" "f") - ("gmane" "g"))) - notmuch-tag-deleted-formats - '(("unread") - ("new") - (".*" (notmuch-apply-face tag 'notmuch-tag-deleted)))) - - (with-eval-after-load "notmuch-tag" - (advice-add #'notmuch-read-tag-changes - :filter-return (lambda (x) (mapcar #'string-trim x)))) - #+end_src -* package - #+begin_src emacs-lisp - (add-to-list 'load-path "/usr/local/share/emacs/site-lisp/") - - (use-package notmuch - :init - (setq notmuch-address-use-company nil - notmuch-address-command (if jao-notmuch-enabled 'internal 'as-is) - notmuch-always-prompt-for-sender t - notmuch-draft-folder "local" - notmuch-draft-quoted-tags '("part") - notmuch-address-internal-completion '(received nil) - notmuch-fcc-dirs - '(("\\(support\\|education\\)@bigml.com" . nil) - (".*@bigml.com" . "bigml.trove +bigml +sent -new -unread") - (".*" . "jao.trove +jao +sent +trove -new -unread")) - notmuch-maildir-use-notmuch-insert t) - - :config - - (add-hook 'message-send-hook #'notmuch-mua-attachment-check) - - (when jao-notmuch-enabled - (define-key message-mode-map (kbd "C-c C-d") #'notmuch-draft-postpone) - (setq message-directory "~/var/mail/" - message-auto-save-directory "/tmp" - mail-user-agent 'message-user-agent)) - - :bind (:map notmuch-common-keymap - (("E" . jao-notmuch-open-enclosure) - ("B" . notmuch-show-resend-message) - ("b" . jao-notmuch-browse-urls)))) - - (use-package jao-notmuch :demand t) - - #+end_src -* hello - #+begin_src emacs-lisp - (defun jao-notmuch-hello--insert-searches (searches title) - (when-let (searches (notmuch-hello-query-counts searches)) - (let* ((cnt (when title - (seq-reduce (lambda (c q) - (+ c (or (plist-get q :count) 0))) - searches - 0))) - (title (if title (format "[ %d %s ]\n\n" cnt title) "\n"))) - (widget-insert (propertize title 'face 'jao-themes-f00)) - (let ((notmuch-column-control 1.0) - (start (point))) - (notmuch-hello-insert-buttons searches) - (indent-rigidly start (point) notmuch-hello-indent))))) - - (defun jao-notmuch-hello-insert-inbox-searches () - (jao-notmuch-hello--insert-searches jao-notmuch-inbox-searches "inbox")) - - (defun jao-notmuch-hello-insert-bigml-searches () - (jao-notmuch-hello--insert-searches jao-notmuch-bigml-searches "bigml")) - - (defun jao-notmuch-hello-insert-mark-searches () - (jao-notmuch-hello--insert-searches jao-notmuch-mark-searches "marks") - (jao-notmuch-hello--insert-searches jao-notmuch-flagged-searches nil)) - - (defun jao-notmuch-hello-insert-feeds-searches () - (jao-notmuch-hello--insert-searches jao-notmuch-feed-searches "feeds")) - - (defun jao-notmuch-hello-insert-emacs-searches () - (jao-notmuch-hello--insert-searches jao-notmuch-emacs-searches "emacs")) - - (defun jao-notmuch-hello-insert-dynamic-searches () - (jao-notmuch-hello--insert-searches jao-notmuch-dynamic-searches "dynamic") - (jao-notmuch-hello--insert-searches jao-notmuch-new-searches nil)) - - (defun jao-notmuch-refresh-agenda () - (interactive) - (save-window-excursion (org-agenda-list)) - (let ((b (current-buffer))) - (pop-to-buffer "*Calendar*") - (goto-char (point-min)) - (calendar-goto-today) - (pop-to-buffer b))) - - (defun jao-notmuch-hello-first () - (interactive) - (let ((inhibit-message t)) - (beginning-of-buffer) - (widget-forward 1))) - - (defun jao-notmuch-refresh-hello (&optional agenda) - (interactive "P") - (ignore-errors - (when (and (string= "Mail" (jao-afio-current-frame)) - (derived-mode-p 'notmuch-hello-mode)) - (when (not (string-blank-p jao-notmuch-minibuffer-string)) - (let ((notmuch-hello-auto-refresh nil)) (notmuch-hello))) - (when agenda (jao-notmuch-refresh-agenda)) - (unless (widget-at) (jao-notmuch-hello-first))))) - - (defvar jao-notmuch-hello--sec-rx "^\\(\\[ [0-9]+\\|All tags:.+\\)") - - (defun jao-notmuch-hello-next-section () - (interactive) - (when (re-search-forward jao-notmuch-hello--sec-rx nil t) - (widget-forward 1))) - - (defun jao-notmuch-hello-prev-section () - (interactive) - (beginning-of-line) - (unless (looking-at-p jao-notmuch-hello--sec-rx) - (re-search-backward jao-notmuch-hello--sec-rx nil t)) - (when (re-search-backward jao-notmuch-hello--sec-rx nil t) - (end-of-line) - (widget-forward 1))) - - (defun jao-notmuch-hello-next () - (interactive) - (if (widget-at) - (widget-button-press (point)) - (jao-notmuch-hello-next-section))) - - (use-package notmuch-hello - :init - (setq notmuch-column-control t - notmuch-hello-sections '(jao-notmuch-hello-insert-bigml-searches - jao-notmuch-hello-insert-inbox-searches - jao-notmuch-hello-insert-feeds-searches - jao-notmuch-hello-insert-emacs-searches - jao-notmuch-hello-insert-mark-searches - jao-notmuch-hello-insert-dynamic-searches - notmuch-hello-insert-alltags) - notmuch-hello-hide-tags nil - notmuch-hello-thousands-separator "," - notmuch-hello-auto-refresh t - notmuch-show-all-tags-list nil - notmuch-show-logo nil - notmuch-show-empty-saved-searches nil) - - :hook ((notmuch-hello-refresh . jao-notmuch-notify) - (jao-afio-switch . jao-notmuch-refresh-hello)) - - :bind (:map notmuch-hello-mode-map - (("a" . jao-notmuch-refresh-agenda) - ("j" . jao-notmuch-jump-search) - ("n" . jao-notmuch-hello-next) - ("p" . widget-backward) - ("S" . consult-notmuch) - ("g" . jao-notmuch-refresh-hello) - ("." . jao-notmuch-hello-first) - ("SPC" . widget-button-press) - ("[" . jao-notmuch-hello-prev-section) - ("]" . jao-notmuch-hello-next-section)))) - - #+end_src -* show - #+begin_src emacs-lisp - (defun jao-notmuch-open-enclosure (add) - (interactive "P") - (with-current-notmuch-show-message - (goto-char (point-min)) - (if (not (search-forward "Enclosure:" nil t)) - (user-error "No enclosure in message body") - (re-search-forward "https?://" nil t) - (if-let (url (thing-at-point-url-at-point)) - (progn - (message "%s %s ..." (if add "Adding" "Playing") url) - (unless add (jao-mpc-clear)) - (jao-mpc-add-url url) - (unless add (jao-mpc-play))) - (error "Found an enclosure, but not a link!"))))) - - (defconst jao-mail-clean-rx - (regexp-opt '("ElDiario.es - ElDiario.es: " "The Guardian: " - "The Conversation – Articles (UK): "))) - - (defun jao-mail-clean-address (args) - (when-let ((address (car args))) - (list (if (string-match ".+ updates on arXiv.org: \\(.+\\)" address) - (with-temp-buffer - (insert (match-string 1 address)) - (let ((shr-width 1000)) - (shr-render-region (point-min) (point-max))) - (replace-regexp-in-string "\"" "" (buffer-string))) - (replace-regexp-in-string jao-mail-clean-rx "" address))))) - - (use-package notmuch-show - :init - (setq gnus-blocked-images "." - notmuch-message-headers - '("To" "Cc" "Date" "Reply-To" "List-Id" "X-RSS-Feed") - notmuch-show-only-matching-messages t - notmuch-show-part-button-default-action 'notmuch-show-view-part - notmuch-wash-signature-lines-max 0 - notmuch-wash-wrap-lines-length 80 - notmuch-wash-citation-lines-prefix 10 - notmuch-wash-citation-lines-suffix 20 - notmuch-show-text/html-blocked-images "." - notmuch-show-header-line " %s") - - :config - - (advice-add 'notmuch-clean-address :filter-args #'jao-mail-clean-address) - - :bind - (:map notmuch-show-mode-map - (("h" . jao-notmuch-goto-tree-buffer) - ("TAB" . jao-notmuch-show-next-button) - ([backtab] . jao-notmuch-show-previous-button) - ("RET" . jao-notmuch-show-ret)))) - #+end_src -* search - #+begin_src emacs-lisp - (use-package notmuch-search - :init (setq notmuch-search-result-format - '(("date" . "%12s ") - ("count" . "%-7s ") - ("authors" . "%-35s") - ("subject" . " %-100s") - (jao-notmuch-format-tags . " (%s)")) - notmuch-search-buffer-name-format "*%s*" - notmuch-saved-search-buffer-name-format "*%s*") - :bind (:map notmuch-search-mode-map - (("RET" . notmuch-tree-from-search-thread) - ("M-RET" . notmuch-search-show-thread)))) - - #+end_src -* tree - #+begin_src emacs-lisp - (defun jao-notmuch-tree--forward (&optional prev) - (interactive) - (forward-line (if prev -1 1)) - (when prev (forward-char 2)) - (jao-notmuch-tree-scroll-or-next)) - - (defun jao-notmuch-tree--backward () - (interactive) - (jao-notmuch-tree--forward t)) - - (defun jao-notmuch--via-url () - (when (window-live-p notmuch-tree-message-window) - (with-selected-window notmuch-tree-message-window - (goto-char (point-min)) - (when (re-search-forward "^Via: http" nil t) - (thing-at-point-url-at-point))))) - - (defun jao-notmuch-browse-url (ext) - (interactive "P") - (when-let (url (or (jao-notmuch--via-url) - (car (last (jao-notmuch-message-urls))))) - (funcall (if ext browse-url-secondary-browser-function #'browse-url) - url))) - - (use-package notmuch-tree - :init - (setq notmuch-tree-result-format - `(("date" . "%12s ") - ("authors" . "%-25s") - (jao-notmuch-msg-ticks . ,jao-mails-regexp) - (jao-notmuch-tree-and-subject . "%>-85s") - (jao-notmuch-format-tags . " (%s)")) - notmuch-unthreaded-result-format notmuch-search-result-format - consult-notmuch-result-format - `((jao-notmuch-msg-ticks . ,jao-mails-regexp) - ("date" . "%12s ") - ("authors" . "%-35s") - ("subject" . " %-100s") - (jao-notmuch-format-tags . " (%s)")) - notmuch-tree-thread-symbols - '((prefix . "─") (top . "─") (top-tee . "┬") - (vertical . "│") (vertical-tee . "├") (bottom . "╰") - (arrow . ""))) - - :config - - (let ((fg (face-attribute 'jao-themes-dimm :foreground))) - (dolist (f '(notmuch-tree-match-tree-face - notmuch-tree-no-match-tree-face)) - (set-face-attribute f nil :family "Source Code Pro" :foreground fg))) - - (jao-notmuch-tree-setup "T") - - (defun jao-notmuch-before-tree (&rest args) - (when (string= (buffer-name) "*notmuch-hello*") - (split-window-right 40) - (other-window 1))) - - (defvar jao-notmuch--visits 0) - - (defun jao-notmuch-after-tree-quit (&optional both) - (when (and (not (derived-mode-p 'notmuch-tree-mode 'notmuch-hello-mode)) - (save-window-excursion (other-window -1) - (derived-mode-p 'notmuch-hello-mode))) - (delete-window) - (jao-notmuch-refresh-hello (= 0 (mod (cl-incf jao-notmuch--visits) 10))))) - - (advice-add 'notmuch-tree :before #'jao-notmuch-before-tree) - (advice-add 'notmuch-tree-quit :after #'jao-notmuch-after-tree-quit) - - :bind (:map notmuch-tree-mode-map - (("b" . jao-notmuch-browse-urls) - ("d" . jao-notmuch-tree-toggle-delete) - ("D" . jao-notmuch-tree-toggle-delete-thread) - ("h" . jao-notmuch-goto-message-buffer) - ("H" . jao-notmuch-click-message-buffer) - ("i" . jao-notmuch-toggle-images) - ("K" . jao-notmuch-tag-jump-and-next) - ("k" . jao-notmuch-tree-read-thread) - ("n" . jao-notmuch-tree-next) - ("N" . jao-notmuch-tree--forward) - ("O" . notmuch-tree-toggle-order) - ("o" . jao-notmuch-tree-widen-search) - ("p" . jao-notmuch-tree-previous) - ("P" . jao-notmuch-tree--backward) - ("r" . notmuch-tree-reply) - ("R" . notmuch-tree-reply-sender) - ("s" . jao-notmuch-tree-toggle-spam) - ("u" . jao-notmuch-tree-toggle-flag) - ("v" . notmuch-tree-scroll-message-window) - ("V" . notmuch-tree-scroll-message-window-back) - ("x" . jao-notmuch-arXiv-capture) - ("<" . jao-notmuch-tree-beginning-of-buffer) - (">" . jao-notmuch-tree-end-of-buffer) - ("\\" . notmuch-tree-view-raw-message) - ("." . jao-notmuch-toggle-mime-parts) - ("=" . jao-notmuch-tree-toggle-message) - ("RET" . jao-notmuch-tree-show-or-scroll) - ("SPC" . jao-notmuch-tree-scroll-or-next) - ("M-g" . jao-notmuch-browse-url) - ("M-u" . jao-notmuch-tree-reset-tags)))) - #+end_src -* org mode - Stolen and adapted from [[https://gist.github.com/fedxa/fac592424473f1b70ea489cc64e08911][Fedor Bezrukov]]. - #+begin_src emacs-lisp - (defvar jao-org-notmuch-last-subject nil) - (defun jao-org-notmuch-last-subject () jao-org-notmuch-last-subject) - - (defun jao-notmuch--add-tags (tags) - (if (derived-mode-p 'notmuch-show-mode) - (notmuch-show-add-tag tags) - (notmuch-tree-add-tag tags))) - - (defun org-notmuch-store-link () - "Store a link to a notmuch mail message." - (cl-case major-mode - ((notmuch-show-mode notmuch-tree-mode) - ;; Store link to the current message - (let* ((id (notmuch-show-get-message-id)) - (link (concat "notmuch:" id)) - (subj (notmuch-show-get-subject)) - (description (format "Mail: %s" subj))) - (setq jao-org-notmuch-last-subject subj) - (when (y-or-n-p "Archive message? ") - (jao-notmuch--add-tags '("+trove"))) - (when (y-or-n-p "Flag message as todo? ") - (jao-notmuch--add-tags '("+flagged"))) - (org-store-link-props - :type "notmuch" - :link link - :description description))) - (notmuch-search-mode - ;; Store link to the thread on the current line - (let* ((id (notmuch-search-find-thread-id)) - (link (concat "notmuch:" id)) - (subj (notmuch-search-find-subject)) - (description (format "Mail: %s" subj))) - (setq jao-org-notmuch-last-subject subj) - (org-store-link-props - :type "notmuch" - :link link - :description description))))) - - (with-eval-after-load "org" - (org-link-set-parameters "notmuch" - :follow 'notmuch-show - :store 'org-notmuch-store-link)) - #+end_src -* arXiv - #+begin_src emacs-lisp - (use-package org-capture - :config - (add-to-list 'org-capture-templates - '("X" "arXiv" entry (file "notes/physics/arxiv.org") - "* %(jao-org-notmuch-last-subject)\n %i" - :immediate-finish t) - t) - (org-capture-upgrade-templates org-capture-templates)) - - (defun jao-notmuch-arXiv-capture () - (interactive) - (save-window-excursion - (jao-notmuch-goto-message-buffer) - (save-excursion - (goto-char (point-min)) - (re-search-forward "\\[ text/html \\]") - (forward-paragraph) - (setq-local transient-mark-mode 'lambda) - (set-mark (point)) - (goto-char (point-max)) - (org-capture nil "X")))) - - #+end_src -* html render - #+begin_src emacs-lisp - (when jao-notmuch-enabled (setq mm-text-html-renderer 'shr)) - #+end_src -* consult - #+begin_src emacs-lisp - (jao-load-path "consult-notmuch") - (require 'consult-notmuch) - (consult-customize consult-notmuch :preview-key 'any) - - (defvar jao-consult-notmuch-history nil) - - (defvar jao-mailbox-folders '("bigml" "jao")) - - (defun jao-consult-notmuch-folder (&optional tree folder) - (interactive "P") - (let ((folder (if folder - (file-name-as-directory folder) - (completing-read "Group: " - jao-mailbox-folders - nil nil nil - jao-consult-notmuch-history - "."))) - (folder (replace-regexp-in-string "/\\(.\\)" ".\\1" folder)) - (init (read-string "Initial query: ")) - (init (format "folder:/%s/ %s" folder init))) - (if tree (consult-notmuch-tree init) (consult-notmuch init)))) - - (with-eval-after-load "notmuch-hello" - (define-key notmuch-hello-mode-map "f" #'jao-consult-notmuch-folder)) - #+end_src -* link hint - #+begin_src emacs-lisp - (with-eval-after-load "link-hint" - (defun jao-link-hint--notmuch-next-part (&optional bound) - (when-let (p (next-single-property-change (point) :notmuch-part nil bound)) - (and (< p (or bound (point-max))) p))) - - (defun jao-link-hint--notmuch-part-p () - (and (get-text-property (point) :notmuch-part) - (when-let (b (button-at (point))) (button-label b)))) - - (link-hint-define-type 'notmuch-part - :next #'jao-link-hint--notmuch-next-part - :at-point-p #'jao-link-hint--notmuch-part-p - :vars '(notmuch-show-mode) - :open #'push-button - :open-message "Toggled" - :open-multiple t) - - (push 'link-hint-notmuch-part link-hint-types)) - - #+end_src diff --git a/org.org b/org.org deleted file mode 100644 index a7c97b5..0000000 --- a/org.org +++ /dev/null @@ -1,317 +0,0 @@ -#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t" :tangle-mode (identity #o644) -#+title: Org (and related) mode configuration - -* General configuration - #+begin_src emacs-lisp - (use-package org - :ensure t - :custom ((org-export-backends '(ascii html latex texinfo))) - :init - (defalias 'jao-open-gnus-frame 'jao-afio--goto-mail) - - (setq org-adapt-indentation t - org-catch-invisible-edits 'smart - org-complete-tags-always-offer-all-agenda-tags t - org-cycle-separator-lines 0 ;; no blank lines when all colapsed - org-deadline-warning-days 14 - org-default-notes-file (expand-file-name "inbox.org" org-directory) - org-directory jao-org-dir - org-display-remote-inline-images 'download ;; 'skip 'cache - org-ellipsis " .." ;; ↴ - org-email-link-description-format "Email %c: %s" - org-enforce-todo-dependencies t - org-fast-tag-selection-single-key 'expert - ;; org-list-demote-modify-bullet '(("+" . "-") ("-" . "+") ("*" . "+")) - org-link-frame-setup - '((gnus . (lambda (&optional x) (jao-open-gnus-frame))) - (file . find-file-other-window)) - org-log-done nil - org-modules '(bbdb bibtex info eww eshell git-link) - org-odd-levels-only t - org-outline-path-complete-in-steps nil - org-refile-allow-creating-parent-nodes 'confirm - org-refile-targets '((nil :maxlevel . 5) - (org-agenda-files :maxlevel . 5)) - org-refile-use-outline-path 'file - org-return-follows-link t - org-reverse-note-order t - org-special-ctrl-a/e t - org-src-fontify-natively t - org-startup-folded t - org-tag-alist nil - org-tags-column -75 - org-todo-keywords - '((sequence "TODO(t)" "STARTED(s!)" "|" "DONE(d!)") - (sequence "REPLY(r)" "WAITING(w!)" "|" "DONE(d!)") - (sequence "TOREAD(T)" "READING(R!)" "|" "READ(a!)") - (sequence "|" "CANCELLED(x!)" "SOMEDAY(o!)" "DONE(d!)")) - org-use-fast-todo-selection t - org-use-speed-commands nil ;; t and then ? to see help - org-gnus-prefer-web-links nil)) - (require 'org) - #+end_src -* Agenda - #+begin_src emacs-lisp - (setq ;; org-agenda-custom-commands - ;; '(("w" todo "WAITING" nil) - ;; ("W" agenda "" ((org-agenda-ndays 21)))) - org-agenda-files (mapcar (lambda (f) - (expand-file-name f jao-org-dir)) - '("inbox.org" "bigml.org")) - org-agenda-block-separator " " - org-agenda-breadcrumbs-separator "•" - org-agenda-current-time-string "•" ;; "*" - org-agenda-time-grid - '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) "" "·") - org-agenda-include-diary t - org-agenda-include-inactive-timestamps t - org-agenda-inhibit-startup nil - org-agenda-restore-windows-after-quit t - org-agenda-show-all-dates t - org-agenda-skip-deadline-if-done t - org-agenda-skip-scheduled-if-done nil - org-agenda-span 14 - org-agenda-start-on-weekday nil - org-agenda-window-setup 'current-window) - #+end_src -* Capture templates - #+BEGIN_SRC emacs-lisp - (setq org-capture-templates - '(("t" "TODO" entry - (file+headline "inbox.org" "Todo") - "* TODO %?\n %i%a" :prepend t) - ("r" "REPLY" entry - (file+headline "inbox.org" "Todo") - "* REPLY %:subject%?\n %t\n %i%a" :prepend t) - ("a" "Appointment" entry - (file+olp "inbox.org" "Appointments") - "* %^T %?\n %a" :time-prompt t) - ("i" "Inbox note" entry (file+headline "inbox.org" "Notes") - "* %a\n %i%?(added on: %u)" :prepend t))) - ;; (org-capture-upgrade-templates org-capture-templates) - #+END_SRC -* MIME and file apps - #+BEGIN_SRC emacs-lisp - (setq org-file-apps - '((system . mailcap) - (".*\\.djvu" . system) - (t . emacs))) - #+END_SRC -* Appearance - #+begin_src emacs-lisp - ;; Show hidden emphasis markers - (use-package org-appear - :ensure t - :hook (org-mode . org-appear-mode)) - - ;; #+caption: Image caption. - ;; #+attr_org: :width 100 - ;; [[file:path/to/image.png]] - - (setq org-startup-indented nil - org-pretty-entities nil - org-hide-emphasis-markers t - org-hide-leading-stars t - org-startup-with-inline-images t - org-image-actual-width '(300)) - - #+end_src -* LaTeX - #+begin_src emacs-lisp - (use-package org-fragtog - :after org - :ensure t - :hook ((org-mode . org-fragtog-mode))) - - (require 'org-fragtog) - - (setq org-format-latex-options - `(:foreground default - :background - ,(if (jao-colors-scheme-dark-p) "black" "white") - :scale 1.25 - :html-foreground "black" - :html-background "Transparent" - :html-scale 1.0 - :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) - org-preview-latex-image-directory - (expand-file-name "~/.emacs.d/cache/ltximg/") - org-latex-hyperref-template nil - org-highlight-latex-and-related '(latex script entities)) - - (require 'ox-latex) - - (use-package cdlatex - :ensure t - :hook ((org-mode . org-cdlatex-mode)) - :diminish ((cdlatex-mode . " £") - (org-cdlatex-mode . " £"))) - - #+end_src - -* Export (minted) - - #+begin_src emacs-lisp - (setq org-latex-listings 'minted - org-latex-packages-alist '(("" "minted")) - org-latex-pdf-process - '("pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f" - "pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f")) - #+end_src - -* Babel and literate programming - - [[http://cachestocaches.com/2018/6/org-literate-programming][Literate Programming with Org-mode]] - - [[http://howardism.org/Technical/Emacs/literate-devops.html][Literate DevOps]] - - #+begin_src emacs-lisp - (setq org-src-window-setup 'other-window) ;; current-window - (require 'org-tempo nil t) ;; <s TAB for 9.2 and later - - (use-package poly-org :ensure t) - - (use-package ob-prolog - :ensure t - :after org) - - (org-babel-do-load-languages - 'org-babel-load-languages - '((calc . t) - (clojure . t) - ;; (elixir . t) - (emacs-lisp .t) - (gnuplot .t) - (haskell . t) - (makefile . t) - (ocaml . t) - (org . t) - (python . t) - (scheme .t) - (shell . t) - (prolog . t))) - #+end_src - -* Org cliplink (link from clipboard) - [[https://github.com/rexim/org-cliplink][GitHub - rexim/org-cliplink: Insert org-mode links from clipboard]] - - #+BEGIN_SRC emacs-lisp - (use-package org-cliplink - :ensure t - :bind (:map org-mode-map ("C-c C-f" . org-cliplink)) - :config - (add-to-list 'org-capture-templates - '("k" "Cliplink capture task" entry - (file+headline "inbox.org" "Todo") - "* TODO %(org-cliplink-capture) %?" :prepend t) - t)) - #+END_SRC - -* Notes - #+begin_src emacs-lisp - (use-package jao-org-notes - :commands (jao-org-notes-setup) - :config - (defun jao-org-notes-note-p () - (string-prefix-p jao-org-notes-dir (buffer-file-name))) - - (defun jao-org-notes-recoll () - "Use consult-recoll to search notes." - (interactive) - (consult-recoll (format "dir:%s " jao-org-notes-dir))) - - (jao-transient-major-mode org - ["Notes" - ("o" "find and open note" jao-org-notes-open) - ("c" "open or create note" jao-org-notes-open-or-create) - ("\\" "grep notes" jao-org-notes-grep) - ("r" "recoll notes" jao-org-notes-recoll)] - ["Current note" :if jao-org-notes-note-p - ("i" "insert link" jao-org-notes-insert-link) - ("t" "insert tags" jao-org-notes-insert-tags) - ("v" "show backlinks" jao-org-notes-backlinks)])) - - (jao-org-notes-setup "n") - #+end_src -* Links - #+begin_src emacs-lisp - (require 'ol-eshell nil t) - (require 'ol-bbdb nil t) - (require 'ol-info nil t) - (setq org-link-abbrev-alist '(("jao.io" "https://jao.io/"))) - - (defun jao-org-link-at-point (&optional copy) - (when (thing-at-point-looking-at "\\[\\[\\([^]]+\\)\\]\\[[^]]+\\]\\]") - (when copy (kill-ring-save (match-beginning 1) (match-end 1))) - (match-string-no-properties 1))) - - (defun jao-org-copy-link-at-point () - (interactive) - (message "%s" (or (jao-org-link-at-point t) "No link at point"))) - - (defun jao-org-insert-link (url title) - (insert (format "[[%s][%s]]" url title))) - - (defun jao-insert-eww-link () - "Look for last eww buffer and insert an org link to it." - (interactive) - (when-let (b (car (jao-eww-session--list-buffers))) - (let ((lnk (with-current-buffer b - (format "[[%s][%s]]" - (eww-current-url) - (jao-eww-buffer-title))))) - (insert lnk)))) - - (use-package jao-org-links - :commands jao-org-links-setup - :bind (("C-c T" . jao-org-insert-doc))) - - (jao-org-links-setup jao-sink-dir) - - (with-eval-after-load "pdf-view" - (define-key pdf-view-mode-map (kbd "C-c o") #'jao-org-pdf-goto-org) - (define-key pdf-view-mode-map (kbd "C-c O") #'jao-org-pdf-goto-org*)) - - (with-eval-after-load "doc-view" - (define-key doc-view-mode-map (kbd "C-c o") #'jao-org-pdf-goto-org) - (define-key doc-view-mode-map (kbd "C-c O") #'jao-org-pdf-goto-org*)) - - #+end_src -* eldoc - #+begin_src emacs-lisp - (defun jao-org-eldoc--hook () - (set (make-local-variable 'eldoc-documentation-function) - 'jao-org-link-at-point) - (eldoc-mode)) - (add-hook 'org-mode-hook 'jao-org-eldoc--hook) - #+end_src -* savedoc - #+begin_src emacs-lisp - (defun jao-org--show-if-hidden () - (when (outline-invisible-p) - (save-excursion - (outline-previous-visible-heading 1) - (org-show-subtree)))) - (add-hook 'org-mode-hook 'jao-org--show-if-hidden t) - #+end_src -* Keybindings - #+begin_src emacs-lisp - (define-key mode-specific-map [?a] 'org-agenda) - (define-key org-mode-map "\C-cv" 'jao-org-copy-link-at-point) - (define-key org-mode-map [(control ?c) tab] 'org-force-cycle-archived) - (define-key org-mode-map [(f7)] 'org-archive-to-archive-sibling) - (define-key org-mode-map "\C-cE" 'jao-insert-eww-link) - (define-key org-mode-map "\C-cW" 'jao-insert-eww-link) - (define-key org-mode-map "\C-c'" 'org-edit-src-code) - (define-key org-mode-map "\C-cO" 'outline-hide-other) - (global-set-key "\C-cr" 'org-capture) - (global-set-key "\C-c\C-l" 'org-store-link) - ;; (global-set-key "\C-cL" 'org-insert-link-global) - (global-set-key "\C-cO" 'org-open-at-point-global) - - (jao-transient-major-mode+ org - ["Links" - ("le" "insert current eww link" jao-insert-eww-link) - ("lf" "insert link from clipboard" org-cliplink) - ("lc" "copy link at point" jao-org-copy-link-at-point)]) - - #+end_src @@ -1,78 +1,17 @@ #+title: Emacs configuration and personal packages -#+property: header-args :tangle ~/.emacs.d/init.el :comments no :results silent -#+auto_tangle: t -* Bootstrap - This is the emacs standard init file, which will load (maybe - tangled) the file [[./init.org][init.org]], checking first whether a fresh tangle is - needed. Note that the rest of elisp tangling in init.org goes to a - different file (namely, the one that is loaded by - =~/.emacs.d/init.el=). - - However, also note that if [[https://github.com/jingtaozf/literate-elisp/blob/master/literate-elisp.org][literate-elisp]] is installed, we load - instead the org file, directly. It's because of that that we start - by setting up packages. A drawback of literate-elisp is that it - only knows how to load with lexical binding set to nil, so i tend to - prefer just loading tangled .el files. The packages [[https://github.com/yilkalargaw/org-auto-tangle][org-auto-tangle]] - (to asyncronously generate those files) and [[https://github.com/oantolin/embark][embark]] (to easily - navigate between the two flavours) come in handy in that scenario. - - Here's the directory where a checkout of this repo lives: - - #+begin_src emacs-lisp - (defvar jao-emacs-dir (expand-file-name "~/etc/emacs")) - #+end_src - - followed by package.el's initialisation: - - #+begin_src emacs-lisp - (setq package-user-dir - (expand-file-name (format "~/.emacs.d/elpa.%s" emacs-major-version)) - package-check-signature 'allow-unsigned) - - (require 'package) - (dolist (a '(("melpa" . "https://melpa.org/packages/") - ("gnu-devel" . "https://elpa.gnu.org/devel/"))) - (add-to-list 'package-archives a t)) - (setf (alist-get "gnu" package-archives nil t #'string=) nil) - - (package-initialize) - #+end_src - - and a tangling helper: - - #+begin_src emacs-lisp - (require 'org) - (defun jao-load-org (file) - (let ((file (concat (file-name-sans-extension file) ".org"))) - (org-babel-load-file (expand-file-name file jao-emacs-dir)))) - #+end_src - - Finally, we load either init.org or its tangled version from - ~jao-emacs-dir~: - - #+begin_src emacs-lisp - (jao-load-org "init") - #+end_src - - You can tangle this readme to generate the minimal init.el file above. - -* Configuration as a set of literate files - -- [[./init.org][init.org]]: main configuration as a literate org file; it uses - (besides lots of packages), many of my libraries in [[./lib][lib]], and loads - on demand the other org files below. -- [[./completion.org][completion.org]]: completion setup using corfu, vertico, consult and - friends. -- [[./org.org][org.org]] org mode configuration. -- [[./blog.org][blog.org]]: blogging using org-static-blog. -- [[./email.org][email.org]]: email handling in emacs. -- [[./gnus.org][gnus.org]]: email using gnus. -- [[./notmuch.org][notmuch.org]]: email using notmuch. -- [[./eww.org][eww.org]]: browsing with eww. -- [[./exwm.org][exwm.org]]: configuration for exwm, loaded when ~jao-exwmn-enable~ is - called. - -The [[./attic][attic]] contains other literate configuration files not currently -used by init.org, like [[./attic/counsel.org][counsel.org]] for old ivy-based completion, or -[[file:attic/w3m.org][w3m.org]] for an emacs-w3m configuration i used for many years. +- [[./init.el][init.el]]: main init file; it uses (besides ELPA packages loaded via + ~use-package~), my unpackaged libraries in [[./lib][lib]], and loads on demand + the other custom files below. + +- [[./custom/jao-custom-completion.el][custom/jao-custom-completion.el]]: completion setup using vertico, + consult and friends. +- [[./custom/jao-custom-org.el][custom/jao-custom-org.el]] org mode configuration. +- [[./custom/jao-custom-blog.el][custom/jao-custom-blog.el]]: blogging using org-static-blog. +- [[./custom/jao-custom-email.el][custom/jao-custom-email.el]]: generic email handling in emacs. +- [[./custom/jao-custom-gnus.el][custom/jao-custom-gnus.el]]: gnus-specific configuration. +- [[./custom/jao-custom-notmuch.el][custom/jao-custom-notmuch.el]]: notmuch-specific configuration. +- [[./custom/jao-custom-eww.el][custom/jao-custom-eww.el]]: browsing with eww. +- [[./custom/jao-custom-exwm.el][custom/jao-custom-exwm.el]]: configuration for exwm. + +The [[./attic][attic]] contains other configuration files not currently used by ~init.el~. |