From e4a0853b306c054e5554f866d731020a7a6f5206 Mon Sep 17 00:00:00 2001 From: BardofSprites <89086143+BardofSprites@users.noreply.github.com> Date: Sat, 27 Dec 2025 15:57:53 -0500 Subject: MAJOR formatting and documentation --- config.org | 3014 +++++++++++++++++++++++++++++++----------------------------- 1 file changed, 1555 insertions(+), 1459 deletions(-) (limited to 'config.org') diff --git a/config.org b/config.org index 400e7f4..67c3f31 100644 --- a/config.org +++ b/config.org @@ -1,5 +1,16 @@ +#+title: My Literate Emacs Configuration +#+author: Daniel Pinkston +#+export_file_name: Literate Emacs +# #+setupfile: ~/Notes/denote/latex-setups/setup.org +#+setupfile: ~/Notes/denote/latex-setups/latex-setup.org +#+latex_compiler: xelatex +#+options: toc:t num:t +#+LATEX_SRC_BLOCK_BACKEND: listings + * Startup ** Early initialization +The ~early-init.el~ removes all the visual fluff like scrollbars and sets up very fundamental Emacs settings that need to be loaded before everything else. + #+begin_src emacs-lisp :tangle early-init.el (setq inhibit-startup-message t) (setq inhibit-startup-screen t) @@ -170,6 +181,12 @@ making an abbreviation to a function." #+end_src * Modules ** bard-emacs-anki +#+begin_quote +[[https://apps.ankiweb.net/][Anki]] is a flashcard program that helps you spend more time on challenging material, and less on what you already know. +#+end_quote + +This is an emacs package that allows me to write flashcards in org mode. I talked about it in my EmacsConf 2024 presentation titled: [[https://www.bardman.dev/technology/emacsconf-2024/][A example of a cohesive student workflow in Emacs]]. + #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-anki.el :mkdirp yes (use-package anki-editor :ensure t @@ -232,7 +249,10 @@ making an abbreviation to a function." (calendar-today-visible . calendar-mark-today) (calendar-mode . denote-journal-calendar-mode) (calendar-today-visible . calendar-mark-holidays)) +#+end_src +**** Orthodox Christian Holidays +#+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-calendar.el :mkdirp yes (use-package orthodox-christian-new-calendar-holidays :ensure t :config @@ -271,6 +291,7 @@ making an abbreviation to a function." (org-clock-persistence-insinuate) (use-package org + ;; not really show what this does anymore :demand t :hook ((org-clock-out . bard/org-clock-update-mode-line))) @@ -318,8 +339,7 @@ making an abbreviation to a function." :config (setq org-habit-show-done-always-green t org-habit-show-habits t - org-habit-show-all-today t) - ) + org-habit-show-all-today t)) #+end_src *** Provide module @@ -344,8 +364,7 @@ making an abbreviation to a function." ;; a sub-directory and use, say, `find-file' to go to your home '~/' ;; or root '/' directory, Vertico will clear the old path to keep ;; only your current input. - (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) - ) + (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy))) #+end_src *** Rfn eshadow @@ -397,6 +416,9 @@ making an abbreviation to a function." #+end_src *** Tab completion +For a long time I really struggled with Emacs tab completion. It still only kind of works most of the time, but I don't want to tweak it to make it work. It works really well with LSP and using Lisp REPL's for languages like Clojure, Common Lisp, and Scheme. However for some languages like Haskell, without the LSP (which hasn't worked for me in the past), it does not work to the extent that I believe it should. Completion is something I'm kind of jealous of when it comes to Neovim vs Emacs. + +**** UI for tab completion #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-completion.el :mkdirp yes (use-package corfu :ensure t @@ -417,6 +439,7 @@ making an abbreviation to a function." (add-to-list 'savehist-additional-variables 'corfu-history))) #+end_src +**** Compilation at point functions (CAPF) #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-completion.el :mkdirp yes (use-package cape :ensure t @@ -482,6 +505,9 @@ making an abbreviation to a function." #+end_src **** Embark +:PROPERTIES: +:ID: ce728534-8fa7-4d4a-96e3-71cb02fc9af4 +:END: #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-completion.el :mkdirp yes (use-package embark :ensure t @@ -1335,12 +1361,60 @@ making an abbreviation to a function." ;; latex editing niceness (use-package org-fragtog :ensure t) + + (with-eval-after-load 'ox-latex + (add-to-list 'org-latex-classes + '("org-plain-latex" + "\\documentclass{article} + [NO-DEFAULT-PACKAGES] + [PACKAGES] + [EXTRA]" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}") + ("\\paragraph{%s}" . "\\paragraph*{%s}") + ("\\subparagraph{%s}" . "\\subparagraph*{%s}")))) + + (setq org-latex-listings t) + (setq org-latex-listings-options + '(("basicstyle" "\\ttfamily") + ("breakatwhitespace" "false") + ("breakautoindent" "true") + ("breaklines" "true") + ("columns" "[c]fullflexible") + ("commentstyle" "") + ("emptylines" "*") + ("extendedchars" "false") + ("fancyvrb" "true") + ("firstnumber" "auto") + ("flexiblecolumns" "false") + ("frame" "single") + ("frameround" "tttt") + ("identifierstyle" "") + ("keepspaces" "true") + ("keywordstyle" "") + ("mathescape" "false") + ("numbers" "left") + ("numbers" "none") + ("numbersep" "5pt") + ("numberstyle" "\\tiny") + ("resetmargins" "false") + ("showlines" "true") + ("showspaces" "false") + ("showstringspaces" "false") + ("showtabs" "true") + ("stepnumber" "2") + ("stringstyle" "") + ("tab" "↹") + ("tabsize" "4") + ("texcl" "false") + ("upquote" "false"))) #+end_src *** Org capture #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-org.el :mkdirp yes (setq org-capture-bookmark nil - org-id-link-to-org-use-id nil) + org-id-link-to-org-use-id t) (require 'org-protocol) (setq org-capture-templates @@ -1547,6 +1621,9 @@ making an abbreviation to a function." #+end_src *** Fonts +:PROPERTIES: +:ID: 542a0f2e-f79e-4272-af55-284c81b16fc3 +:END: #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-theme.el :mkdirp yes (use-package fontaine :ensure nil @@ -1573,7 +1650,6 @@ making an abbreviation to a function." :ensure t) #+end_src - *** Binding for custom select theme function #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-theme.el :mkdirp yes (global-set-key (kbd "M-") #'bard/select-theme) @@ -2262,7 +2338,7 @@ Watch [[https://protesilaos.com/codelog/2024-02-08-emacs-window-rules-display-bu ) #+end_src -*** Provide the module +*** Provide module #+begin_src emacs-lisp :tangle bard-emacs-modules/bard-emacs-writing.el :mkdirp yes (provide 'bard-emacs-writing) #+end_src @@ -2270,140 +2346,157 @@ Watch [[https://protesilaos.com/codelog/2024-02-08-emacs-window-rules-display-bu * Libraries ** bard-calendar #+begin_src emacs-lisp :tangle bard-elisp/bard-calendar.el :mkdirp yes -(require 'org) - -;; Org Clock + (require 'org) +#+end_src -(defun bard/auto-clock-in () - "Automatically clock in when task marked in progress (INPROG), - and start study session." - (when (equal (org-get-todo-state) "INPROG") - (org-clock-in) - (bard/study-session))) +*** Study session program spawning +I use a timer to study sometimes when I really don't lock in. It is a [[https://github.com/BardofSprites/dotfiles-stow/blob/master/bin/.local/bin/scripts/lisp/study.lisp][common lisp script]] that manages process of a timer called [[https://github.com/tsoding/sowon][sowon]]. -(defun bard/study-session () - "Prompt for study parameters, run study session, and clock out when done." - (interactive) - (let* ((study-time (read-string "Study time (minutes): ")) - (break-time (read-string "Break time (minutes): ")) - (sessions (read-string "Number of sessions: ")) - (command (format "study %s %s %s" study-time break-time sessions)) - (process (start-process-shell-command "study-session" "*study*" command))) - (set-process-sentinel - process - (lambda (_proc event) - (when (string= event "finished\n") - (progn (org-clock-out) - (pop-to-buffer-same-window "todo.org"))))))) - -(defun bard/org-clock-report () - (interactive) - (bard/new-org-buffer) - (org-clock-report)) +#+begin_src emacs-lisp :tangle bard-elisp/bard-calendar.el :mkdirp yes + (defun bard/auto-clock-in () + "Automatically clock in when task marked in progress (INPROG), + and start study session." + (when (equal (org-get-todo-state) "INPROG") + (org-clock-in) + (bard/study-session))) + + (defun bard/study-session () + "Prompt for study parameters, run study session, and clock out when done." + (interactive) + (let* ((study-time (read-string "Study time (minutes): ")) + (break-time (read-string "Break time (minutes): ")) + (sessions (read-string "Number of sessions: ")) + (command (format "study %s %s %s" study-time break-time sessions)) + (process (start-process-shell-command "study-session" "*study*" command))) + (set-process-sentinel + process + (lambda (_proc event) + (when (string= event "finished\n") + (progn (org-clock-out) + (pop-to-buffer-same-window "todo.org"))))))) +#+end_src -(defun bard/org-clock-update-mode-line () - (interactive) - (setq org-mode-line-string nil) - (force-mode-line-update)) - -(defun bard/org-clock-task-string () - "Return a simplified org clock task string." - (if (and (boundp 'org-mode-line-string) - (not (string-equal "" org-mode-line-string)) - org-mode-line-string) - (substring-no-properties org-mode-line-string) - "No task clocked in")) - -(defun bard/open-calendar () - "Opens calendar as only window" - (interactive) - (calendar) - (delete-other-windows)) +*** Org clock +#+begin_src emacs-lisp :tangle bard-elisp/bard-calendar.el :mkdirp yes + (defun bard/org-clock-report () + "Generate an org clock report in a separate org buffer." + (interactive) + (bard/new-org-buffer) + (org-clock-report)) -;; Org Agenda + (defun bard/org-clock-update-mode-line () + "Update the modeline, not sure why I have this." + (interactive) + (setq org-mode-line-string nil) + (force-mode-line-update)) + + (defun bard/org-clock-task-string () + "Return a simplified org clock task string. + Used in FVWM3 configuration to show clocked task in FVWMbuttons." + (if (and (boundp 'org-mode-line-string) + (not (string-equal "" org-mode-line-string)) + org-mode-line-string) + (substring-no-properties org-mode-line-string) + "No task clocked in")) +#+end_src -(defun bard/choose-agenda () - "For viewing my custom agenda" - (interactive) - (let ((agenda-views '("Default" "Monthly" "Yearly"))) - (setq chosen-view (completing-read "Choose an agenda view: " agenda-views)) - (cond - ((string= chosen-view "Yearly") - (org-agenda nil "Y")) - ((string= chosen-view "Monthly") - (org-agenda nil "M")) - ((string= chosen-view "Default") - (org-agenda nil "D"))))) - -(defun bard/default-agenda () - "For viewing my custom agenda" - (interactive) - (org-agenda nil "D")) +*** Open the calendar in its own window +I use this in window manager status bar to open a popup window to view the dates on the calendar. +#+begin_src emacs-lisp :tangle bard-elisp/bard-calendar.el :mkdirp yes + (defun bard/open-calendar () + "Opens calendar as only window" + (interactive) + (calendar) + (delete-other-windows)) +#+end_src -(provide 'bard-calendar) -;;; bard-calendar.el ends here +*** Org agenda +#+begin_src emacs-lisp :tangle bard-elisp/bard-calendar.el :mkdirp yes + (defun bard/choose-agenda () + "For viewing my custom agenda" + (interactive) + (let ((agenda-views '("Default" "Monthly" "Yearly"))) + (setq chosen-view (completing-read "Choose an agenda view: " agenda-views)) + (cond + ((string= chosen-view "Yearly") + (org-agenda nil "Y")) + ((string= chosen-view "Monthly") + (org-agenda nil "M")) + ((string= chosen-view "Default") + (org-agenda nil "D"))))) + + (defun bard/default-agenda () + "For viewing my custom agenda" + (interactive) + (org-agenda nil "D")) +#+end_src +*** Provide library +#+begin_src emacs-lisp :tangle bard-elisp/bard-calendar.el :mkdirp yes + (provide 'bard-calendar) + ;;; bard-calendar.el ends here #+end_src ** bard-compile +Code taken from [[http://endlessparentheses.com/ansi-colors-in-the-compilation-buffer-output.html][here]]. I need this to solve a problem I had with pros-cli back when I did robotics in high school. The program had a bunch of color codes that weren't properly displayed in the compliation output. I really like using ~M-x compile~ for C/C++ development specifically. #+begin_src emacs-lisp :tangle bard-elisp/bard-compile.el :mkdirp yes -;; Stolen from (http://endlessparentheses.com/ansi-colors-in-the-compilation-buffer-output.html) -(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) - -;; Stolen from (https://oleksandrmanzyuk.wordpress.com/2011/11/05/better-emacs-shell-part-i/) -(defun regexp-alternatives (regexps) - "Return the alternation of a list of regexps." - (mapconcat (lambda (regexp) - (concat "\\(?:" regexp "\\)")) - regexps "\\|")) - -(defvar non-sgr-control-sequence-regexp nil - "Regexp that matches non-SGR control sequences.") - -(setq non-sgr-control-sequence-regexp - (regexp-alternatives - '(;; icon name escape sequences - "\033\\][0-2];.*?\007" - ;; non-SGR CSI escape sequences - "\033\\[\\??[0-9;]*[^0-9;m]" - ;; noop - "\012\033\\[2K\033\\[1F" - ))) - -(defun filter-non-sgr-control-sequences-in-region (begin end) - (save-excursion - (goto-char begin) - (while (re-search-forward - non-sgr-control-sequence-regexp end t) - (replace-match "")))) - -(defun filter-non-sgr-control-sequences-in-output (ignored) - (let ((start-marker - (or comint-last-output-start - (point-min-marker))) - (end-marker - (process-mark - (get-buffer-process (current-buffer))))) - (filter-non-sgr-control-sequences-in-region - start-marker - end-marker))) - -(add-hook 'comint-output-filter-functions - 'filter-non-sgr-control-sequences-in-output) - -(provide 'bard-compile) + (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) + + ;; Stolen from (https://oleksandrmanzyuk.wordpress.com/2011/11/05/better-emacs-shell-part-i/) + (defun regexp-alternatives (regexps) + "Return the alternation of a list of regexps." + (mapconcat (lambda (regexp) + (concat "\\(?:" regexp "\\)")) + regexps "\\|")) + + (defvar non-sgr-control-sequence-regexp nil + "Regexp that matches non-SGR control sequences.") + + (setq non-sgr-control-sequence-regexp + (regexp-alternatives + '(;; icon name escape sequences + "\033\\][0-2];.*?\007" + ;; non-SGR CSI escape sequences + "\033\\[\\??[0-9;]*[^0-9;m]" + ;; noop + "\012\033\\[2K\033\\[1F" + ))) + + (defun filter-non-sgr-control-sequences-in-region (begin end) + (save-excursion + (goto-char begin) + (while (re-search-forward + non-sgr-control-sequence-regexp end t) + (replace-match "")))) + + (defun filter-non-sgr-control-sequences-in-output (ignored) + (let ((start-marker + (or comint-last-output-start + (point-min-marker))) + (end-marker + (process-mark + (get-buffer-process (current-buffer))))) + (filter-non-sgr-control-sequences-in-region + start-marker + end-marker))) + + (add-hook 'comint-output-filter-functions + 'filter-non-sgr-control-sequences-in-output) + + (provide 'bard-compile) #+end_src ** bard-email +Word for word copy of Protesilaos notmuch library. Email in Emacs is already complicated enough, and I had enough of a hard time without his help. #+begin_src emacs-lisp :tangle bard-elisp/bard-email.el :mkdirp yes (require 'prot-common) (eval-when-compile (require 'cl-lib)) @@ -2532,6 +2625,8 @@ next invocation of 'notmuch new'." #+end_src ** bard-embark +Main embark configuration found [[id:ce728534-8fa7-4d4a-96e3-71cb02fc9af4][here]]. This is another one of the files I borrowed from Protesilaos, but renamed/modified so I can remember. + #+begin_src emacs-lisp :tangle bard-elisp/bard-embark.el :mkdirp yes (require 'embark) @@ -2622,133 +2717,140 @@ next invocation of 'notmuch new'." (advice-add #'embark-minimal-indicator :override #'bard-embark-no-minimal-indicator) (provide 'bard-embark) - #+end_src ** bard-eshell #+begin_src emacs-lisp :tangle bard-elisp/bard-eshell.el :mkdirp yes -(require 'cl-lib) -(require 'eshell) - -;; aliases -(setq bard/eshell-aliases - '((g . magit) - (gl . magit-log) - (d . dired) - (o . find-file) - (oo . find-file-other-window) - (l . (lambda () (eshell/ls '-la))) - (eshell/clear . eshell/clear-scrollback))) - -(mapc (lambda (alias) - (defalias (car alias) (cdr alias))) - bard/eshell-aliases) - -(defun prot-eshell--cd (dir) - "Routine to cd into DIR." - (delete-region eshell-last-output-end (point-max)) - (when (> eshell-last-output-end (point)) - (goto-char eshell-last-output-end)) - (insert-and-inherit "cd " (eshell-quote-argument dir)) - (eshell-send-input)) - -(defun prot-eshell-complete-recent-dir (dir &optional arg) - "Switch to a recent Eshell directory. -When called interactively, DIR is selected with completion from -the elements of `eshell-last-dir-ring'. -With optional ARG prefix argument (\\[universal-argument]) also -open the directory in a `dired' buffer." - (interactive - (list - (if-let ((dirs (ring-elements eshell-last-dir-ring))) - (completing-read "Switch to recent dir: " dirs nil t) - (user-error "There is no Eshell history for recent directories")) - current-prefix-arg)) - (prot-eshell--cd dir) - ;; UPDATE 2022-01-04 10:48 +0200: The idea for `dired-other-window' - ;; was taken from Sean Whitton's `spw/eshell-cd-recent-dir'. Check - ;; Sean's dotfiles: . - (when arg - (dired-other-window dir))) - -(defun bard/eshell-find-file-at-point () - "Run `find-file` to find file" - (interactive) - (let ((file (ffap-file-at-point))) - (if file - (find-file file) - (user-error "No file at point")))) - -(defcustom prot-eshell-output-buffer "*Exported Eshell output*" - "Name of buffer with the last output of Eshell command. -Used by `prot-eshell-export'." - :type 'string - :group 'prot-eshell) + (require 'cl-lib) + (require 'eshell) +#+end_src -(defcustom prot-eshell-output-delimiter "* * *" - "Delimiter for successive `prot-eshell-export' outputs. -This is formatted internally to have newline characters before -and after it." - :type 'string - :group 'prot-eshell) +*** Eshell aliases +#+begin_src emacs-lisp :tangle bard-elisp/bard-eshell.el :mkdirp yes + ;; aliases + (setq bard/eshell-aliases + '((g . magit) + (gl . magit-log) + (d . dired) + (o . find-file) + (oo . find-file-other-window) + (l . (lambda () (eshell/ls '-la))) + (eshell/clear . eshell/clear-scrollback))) + + (mapc (lambda (alias) + (defalias (car alias) (cdr alias))) + bard/eshell-aliases) +#+end_src -(defun prot-eshell--command-prompt-output () - "Capture last command prompt and its output." - (let ((beg (save-excursion - (goto-char (eshell-beginning-of-input)) - (goto-char (point-at-bol))))) - (when (derived-mode-p 'eshell-mode) - (buffer-substring-no-properties beg (eshell-end-of-output))))) +*** Prot-eshell code +I believe Protesilaos has stopped using eshell, but I went back in his git history to the time when he used it in a video and took some custom elisp from there. -;;;###autoload -(defun prot-eshell-export () - "Produce a buffer with output of the last Eshell command. -If `prot-eshell-output-buffer' does not exist, create it. Else -append to it, while separating multiple outputs with -`prot-eshell-output-delimiter'." - (interactive) - (let ((eshell-output (prot-eshell--command-prompt-output))) - (with-current-buffer (get-buffer-create prot-eshell-output-buffer) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (unless (eq (point-min) (point-max)) - (insert (format "\n%s\n\n" prot-eshell-output-delimiter))) - (goto-char (point-at-bol)) - (insert eshell-output) - (switch-to-buffer-other-window (current-buffer)))))) - -(defgroup bard-eshell-faces nil - "Faces for my custom modeline." - :group 'prot-eshell-faces) - -(defface bard-eshell-highlight-yellow-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#805000" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#ffc800" :foreground "black") - (t :background "yellow" :foreground "black")) - "Face for modeline indicators with a background." - :group 'bard-eshell-faces) - -(defun prot-eshell-narrow-output-highlight-regexp (regexp) - "Narrow to last command output and highlight REGEXP." - (interactive - (list (read-regexp "Regexp to highlight" nil 'prot-eshell--output-highlight-history))) - (narrow-to-region (eshell-beginning-of-output) - (eshell-end-of-output)) - (goto-char (point-min)) - (highlight-regexp regexp 'prot-eshell-highlight-yellow-bg) - (message "%s to last output and highlighted '%s'" - (propertize "Narrowed" 'face 'bold) - (propertize regexp 'face 'italic))) - -(defun select-or-create (arg) - "Commentary ARG." - (if (string= arg "New eshell") - (eshell t) - (switch-to-buffer arg))) - (defun eshell-switcher (&optional arg) +#+begin_src emacs-lisp :tangle bard-elisp/bard-eshell.el :mkdirp yes + (defun prot-eshell--cd (dir) + "Routine to cd into DIR." + (delete-region eshell-last-output-end (point-max)) + (when (> eshell-last-output-end (point)) + (goto-char eshell-last-output-end)) + (insert-and-inherit "cd " (eshell-quote-argument dir)) + (eshell-send-input)) + + (defun prot-eshell-complete-recent-dir (dir &optional arg) + "Switch to a recent Eshell directory. + When called interactively, DIR is selected with completion from + the elements of `eshell-last-dir-ring'. + With optional ARG prefix argument (\\[universal-argument]) also + open the directory in a `dired' buffer." + (interactive + (list + (if-let ((dirs (ring-elements eshell-last-dir-ring))) + (completing-read "Switch to recent dir: " dirs nil t) + (user-error "There is no Eshell history for recent directories")) + current-prefix-arg)) + (prot-eshell--cd dir) + ;; UPDATE 2022-01-04 10:48 +0200: The idea for `dired-other-window' + ;; was taken from Sean Whitton's `spw/eshell-cd-recent-dir'. Check + ;; Sean's dotfiles: . + (when arg + (dired-other-window dir))) + + (defun bard/eshell-find-file-at-point () + "Run `find-file` to find file" + (interactive) + (let ((file (ffap-file-at-point))) + (if file + (find-file file) + (user-error "No file at point")))) + + (defcustom prot-eshell-output-buffer "*Exported Eshell output*" + "Name of buffer with the last output of Eshell command. + Used by `prot-eshell-export'." + :type 'string + :group 'prot-eshell) + + (defcustom prot-eshell-output-delimiter "* * *" + "Delimiter for successive `prot-eshell-export' outputs. + This is formatted internally to have newline characters before + and after it." + :type 'string + :group 'prot-eshell) + + (defun prot-eshell--command-prompt-output () + "Capture last command prompt and its output." + (let ((beg (save-excursion + (goto-char (eshell-beginning-of-input)) + (goto-char (point-at-bol))))) + (when (derived-mode-p 'eshell-mode) + (buffer-substring-no-properties beg (eshell-end-of-output))))) + + ;;;###autoload + (defun prot-eshell-export () + "Produce a buffer with output of the last Eshell command. + If `prot-eshell-output-buffer' does not exist, create it. Else + append to it, while separating multiple outputs with + `prot-eshell-output-delimiter'." + (interactive) + (let ((eshell-output (prot-eshell--command-prompt-output))) + (with-current-buffer (get-buffer-create prot-eshell-output-buffer) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (unless (eq (point-min) (point-max)) + (insert (format "\n%s\n\n" prot-eshell-output-delimiter))) + (goto-char (point-at-bol)) + (insert eshell-output) + (switch-to-buffer-other-window (current-buffer)))))) + + (defgroup bard-eshell-faces nil + "Faces for my custom modeline." + :group 'prot-eshell-faces) + + (defface bard-eshell-highlight-yellow-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#805000" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#ffc800" :foreground "black") + (t :background "yellow" :foreground "black")) + "Face for modeline indicators with a background." + :group 'bard-eshell-faces) + + (defun prot-eshell-narrow-output-highlight-regexp (regexp) + "Narrow to last command output and highlight REGEXP." + (interactive + (list (read-regexp "Regexp to highlight" nil 'prot-eshell--output-highlight-history))) + (narrow-to-region (eshell-beginning-of-output) + (eshell-end-of-output)) + (goto-char (point-min)) + (highlight-regexp regexp 'prot-eshell-highlight-yellow-bg) + (message "%s to last output and highlighted '%s'" + (propertize "Narrowed" 'face 'bold) + (propertize regexp 'face 'italic))) + + (defun select-or-create (arg) + "Commentary ARG." + (if (string= arg "New eshell") + (eshell t) + (switch-to-buffer arg))) + (defun eshell-switcher (&optional arg) "Commentary ARG." (interactive) (let* ( @@ -2759,776 +2861,772 @@ append to it, while separating multiple outputs with (cond ((eq num-buffers 0) (eshell (or arg t))) ((not in-eshellp) (switch-to-buffer (car buffers))) (t (select-or-create (completing-read "Select Shell:" (cons "New eshell" names))))))) +#+end_src -;; taken from https://github.com/karthink/.emacs.d/blob/master/lisp/setup-shells.el -(use-package eshell - :defer - :config - (setq eshell-prompt-regexp "^.* λ " +*** Prompt configuration +#+begin_src emacs-lisp :tangle bard-elisp/bard-eshell.el :mkdirp yes + ;; taken from https://github.com/karthink/.emacs.d/blob/master/lisp/setup-shells.el + (use-package eshell + :defer + :config + (setq eshell-prompt-regexp "^.* λ " eshell-prompt-function #'bard/eshell-default-prompt-fn) - (defun bard/eshell-default-prompt-fn () - "Generate the prompt string for eshell. Use for `eshell-prompt-function'." - (concat (if (bobp) "" "\n") - (let ((pwd (eshell/pwd))) - (propertize (if (equal pwd "~") - pwd - (abbreviate-file-name pwd)) - 'face 'bard/eshell-prompt-pwd)) - (propertize (bard/eshell--current-git-branch) - 'face 'bard/eshell-prompt-git-branch) - (propertize " λ" 'face (if (zerop eshell-last-command-status) 'success 'error)) - " ")) - - (defsubst bard/eshell--current-git-branch () - ;; TODO Refactor me - (cl-destructuring-bind (status . output) - (with-temp-buffer (cons - (or (call-process "git" nil t nil "symbolic-ref" "-q" "--short" "HEAD") - (call-process "git" nil t nil "describe" "--all" "--always" "HEAD") - -1) - (string-trim (buffer-string)))) - (if (equal status 0) - (format " [%s]" output) - ""))) - - (defface bard/eshell-prompt-pwd '((t (:inherit font-lock-keyword-face))) - "TODO" - :group 'eshell) - - (defface bard/eshell-prompt-git-branch '((t (:inherit font-lock-builtin-face))) - "TODO" - :group 'eshell)) - -(provide 'bard-eshell) + (defun bard/eshell-default-prompt-fn () + "Generate the prompt string for eshell. Use for `eshell-prompt-function'." + (concat (if (bobp) "" "\n") + (let ((pwd (eshell/pwd))) + (propertize (if (equal pwd "~") + pwd + (abbreviate-file-name pwd)) + 'face 'bard/eshell-prompt-pwd)) + (propertize (bard/eshell--current-git-branch) + 'face 'bard/eshell-prompt-git-branch) + (propertize " λ" 'face (if (zerop eshell-last-command-status) 'success 'error)) + " ")) + + (defsubst bard/eshell--current-git-branch () + ;; TODO Refactor me + (cl-destructuring-bind (status . output) + (with-temp-buffer (cons + (or (call-process "git" nil t nil "symbolic-ref" "-q" "--short" "HEAD") + (call-process "git" nil t nil "describe" "--all" "--always" "HEAD") + -1) + (string-trim (buffer-string)))) + (if (equal status 0) + (format " [%s]" output) + ""))) + + (defface bard/eshell-prompt-pwd '((t (:inherit font-lock-keyword-face))) + "TODO" + :group 'eshell) + + (defface bard/eshell-prompt-git-branch '((t (:inherit font-lock-builtin-face))) + "TODO" + :group 'eshell)) +#+end_src +*** Provide library +#+begin_src emacs-lisp :tangle bard-elisp/bard-eshell.el :mkdirp yes + (provide 'bard-eshell) #+end_src ** bard-media +*** Load required libraries #+begin_src emacs-lisp :tangle bard-elisp/bard-media.el :mkdirp yes -(require 'cl-lib) -(require 'seq) -(require 'emms) -(require 'image-dired) -(require 'dired-x) - -(defun bard/play-youtube-video () - "Play the YouTube URL at point or prompt for one if none is found." - (interactive) - (let* ((url-at-point (thing-at-point 'url t)) - (url (if (and url-at-point - (string-match-p "https?://\\(www\\.\\)?\\(youtube\\.com\\|youtu\\.be\\)" url-at-point)) - url-at-point - (read-string "Enter YouTube URL: ")))) - (if (and url (string-match-p "https?://\\(www\\.\\)?\\(youtube\\.com\\|youtu\\.be\\)" url)) - (async-shell-command (format "mpv '%s'" url)) - (message "The URL is not a valid YouTube link: %s" url)))) - -(defun bard/save-emms-watch-later () - "Save the current EMMS playlist to `bard/watch-later-file` using `bard/emms-playlist-format`." - (interactive) - (when (and bard/watch-later-file bard/emms-playlist-format) - (emms-playlist-save bard/emms-playlist-format bard/watch-later-file) - (message "Playlist saved to %s" bard/watch-later-file))) - -(defun bard/image-browser-choose (directory) - "Open nsxiv in thumbnail mode on DIRECTORY. -Asks the user whether to enable recursive mode and whether to output marked files to a buffer." - (interactive "DSelect directory: ") - (let* ((recursive (if (y-or-n-p "Recursive searching? ") "-r" "")) - (stdout (if (y-or-n-p "Output marked files to buffer? ") "-o" "")) - (full-dir (expand-file-name directory)) - (args (remove "" (list "nsxiv" "-t" stdout recursive full-dir)))) - - ;; Pre-clear the output buffer if needed - (when (string= stdout "-o") - (with-current-buffer (get-buffer-create "*nsxiv*") - (read-only-mode 0) - (erase-buffer))) - - (message "Running: %s" (string-join args " ")) - - (let ((process (apply #'start-process "nsxiv" "*nsxiv*" args))) - (when (string= stdout "-o") - (set-process-sentinel - process - (lambda (proc event) - (when (string= event "finished\n") - (with-current-buffer "*nsxiv*" - (read-only-mode nil) - (goto-char (point-min))) - ;; Read marked files - (let ((files (with-current-buffer "*nsxiv*" - (split-string (buffer-string) "\n" t)))) - (bard/open-marked-in-dired files))))) - (pop-to-buffer "*nsxiv*"))))) - -(defun bard/open-marked-in-dired (files) - "Open a list of FILES in an interactive Dired buffer." - (if (and files (listp files)) - (dired (cons "*nsxiv-marked*" files)) - (message "No valid files to show in Dired."))) - -(defun bard/image-browser-marked () - "Open nsxiv on the marked files in Dired. -Assumes that files have already been validated." - (let ((files (dired-get-marked-files))) - (message "Opening marked files: %s" (string-join files ", ")) - (apply #'start-process "nsxiv" "*nsxiv*" "nsxiv" "-t" files))) - -(defun bard/image-browser () - "Open nsxiv in a context-sensitive way: -- If in Dired with marked files, open those with nsxiv. -- If in Dired with no marked files, prompt for a directory. -- If not in Dired, prompt for a directory." - (interactive) - (cond - ;; In Dired and files are marked - ((and (derived-mode-p 'dired-mode) - (< 1 (length (dired-get-marked-files)))) - (message "Opening marked files from Dired...") - (bard/image-browser-marked)) - - ;; In Dired but no marked files - ((derived-mode-p 'dired-mode) - (message "No files marked in Dired. Prompting for directory...") - (call-interactively #'bard/image-browser-choose)) - - ;; Not in Dired - (t - (message "Not in Dired. Prompting for directory...") - (call-interactively #'bard/image-browser-choose)))) - -(defun bard/emms-download-current-video (destination) - "Download the currently playing EMMS video and move it to DESTINATION." - (interactive "DSelect destination directory: ") + (require 'cl-lib) + (require 'seq) (require 'emms) - (let* ((track (emms-playlist-current-selected-track)) - (url (emms-track-get track 'name)) - (default-directory (file-name-as-directory temporary-file-directory)) - (downloader (executable-find "yt-dlp")) - (output-template "%(title)s.%(ext)s")) - (unless downloader - (error "yt-dlp or youtube-dl is not installed or not in PATH")) - (unless (string-match-p "^https?://" url) - (error "Current track is not a valid video URL")) - - (let ((cmd (format "%s -o \"%s\" \"%s\"" - downloader output-template url))) - (message "Downloading video from: %s" url) - (let ((exit-code (shell-command cmd))) - (if (not (eq exit-code 0)) - (error "Download failed, see *Messages* for details") - ;; Move the downloaded file - (let* ((downloaded-file (car (directory-files default-directory t ".*\\(mp4\\|mkv\\|webm\\)$" 'time))) - (target-path (expand-file-name (file-name-nondirectory downloaded-file) destination))) - (rename-file downloaded-file target-path t) - (message "Video saved to: %s" target-path))))))) - -(provide 'bard-media.el) - + (require 'image-dired) + (require 'dired-x) #+end_src -** bard-modeline -#+begin_src emacs-lisp :tangle bard-elisp/bard-modeline.el :mkdirp yes -(require 'prot-common) - -(defgroup prot-modeline nil - "Custom modeline that is stylistically close to the default." - :group 'mode-line) - -(defgroup prot-modeline-faces nil - "Faces for my custom modeline." - :group 'prot-modeline) - -(defcustom prot-modeline-string-truncate-length 9 - "String length after which truncation should be done in small windows." - :type 'natnum) - -(defun mode-line-window-selected-p () - "Return non-nil if we're updating the mode line for the selected window. -This function is meant to be called in `:eval' mode line -constructs to allow altering the look of the mode line depending -on whether the mode line belongs to the currently selected window -or not." - (let ((window (selected-window))) - (or (eq window (old-selected-window)) - (and (minibuffer-window-active-p (minibuffer-window)) - (with-selected-window (minibuffer-window) - (eq window (minibuffer-selected-window))))))) - -;;;; Faces - -(defface prot-modeline-indicator-button nil - "Generic face used for indicators that have a background. -Modify this face to, for example, add a :box attribute to all -relevant indicators (combines nicely with my `spacious-padding' -package).") - -(defface prot-modeline-indicator-red - '((default :inherit bold) - (((class color) (min-colors 88) (background light)) - :foreground "#880000") - (((class color) (min-colors 88) (background dark)) - :foreground "#ff9f9f") - (t :foreground "red")) - "Face for modeline indicators (e.g. see my `notmuch-indicator')." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-red-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#aa1111" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#ff9090" :foreground "black") - (t :background "red" :foreground "black")) - "Face for modeline indicators with a background." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-green - '((default :inherit bold) - (((class color) (min-colors 88) (background light)) - :foreground "#005f00") - (((class color) (min-colors 88) (background dark)) - :foreground "#73fa7f") - (t :foreground "green")) - "Face for modeline indicators (e.g. see my `notmuch-indicator')." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-green-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#207b20" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#77d077" :foreground "black") - (t :background "green" :foreground "black")) - "Face for modeline indicators with a background." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-yellow - '((default :inherit bold) - (((class color) (min-colors 88) (background light)) - :foreground "#6f4000") - (((class color) (min-colors 88) (background dark)) - :foreground "#f0c526") - (t :foreground "yellow")) - "Face for modeline indicators (e.g. see my `notmuch-indicator')." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-yellow-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#805000" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#ffc800" :foreground "black") - (t :background "yellow" :foreground "black")) - "Face for modeline indicators with a background." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-blue - '((default :inherit bold) - (((class color) (min-colors 88) (background light)) - :foreground "#00228a") - (((class color) (min-colors 88) (background dark)) - :foreground "#88bfff") - (t :foreground "blue")) - "Face for modeline indicators (e.g. see my `notmuch-indicator')." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-blue-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#0000aa" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#77aaff" :foreground "black") - (t :background "blue" :foreground "black")) - "Face for modeline indicators with a background." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-magenta - '((default :inherit bold) - (((class color) (min-colors 88) (background light)) - :foreground "#6a1aaf") - (((class color) (min-colors 88) (background dark)) - :foreground "#e0a0ff") - (t :foreground "magenta")) - "Face for modeline indicators (e.g. see my `notmuch-indicator')." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-magenta-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#6f0f9f" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#e3a2ff" :foreground "black") - (t :background "magenta" :foreground "black")) - "Face for modeline indicators with a background." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-cyan - '((default :inherit bold) - (((class color) (min-colors 88) (background light)) - :foreground "#004060") - (((class color) (min-colors 88) (background dark)) - :foreground "#30b7cc") - (t :foreground "cyan")) - "Face for modeline indicators (e.g. see my `notmuch-indicator')." - :group 'prot-modeline-faces) - -(defface prot-modeline-indicator-cyan-bg - '((default :inherit (bold prot-modeline-indicator-button)) - (((class color) (min-colors 88) (background light)) - :background "#006080" :foreground "white") - (((class color) (min-colors 88) (background dark)) - :background "#40c0e0" :foreground "black") - (t :background "cyan" :foreground "black")) - "Face for modeline indicators with a background." - :group 'prot-modeline-faces) - -;;;; Common helper functions - -(defun prot-modeline--string-truncate-p (str) - "Return non-nil if STR should be truncated." - (and (prot-common-window-small-p) - (> (length str) prot-modeline-string-truncate-length) - (not (one-window-p :no-minibuffer)))) - -(defun prot-modeline--truncate-p () - "Return non-nil if truncation should happen. -This is a more general and less stringent variant of -`prot-modeline--string-truncate-p'." - (and (prot-common-window-small-p) - (not (one-window-p :no-minibuffer)))) - -(defun prot-modeline-string-truncate (str) - "Return truncated STR, if appropriate, else return STR. -Truncation is done up to `prot-modeline-string-truncate-length'." - (if (prot-modeline--string-truncate-p str) - (concat (substring str 0 prot-modeline-string-truncate-length) "...") - str)) - -(defun prot-modeline-string-truncate-end (str) - "Like `prot-modeline-string-truncate' but truncate from STR beginning." - (if (prot-modeline--string-truncate-p str) - (concat "..." (substring str (- prot-modeline-string-truncate-length))) - str)) - -(defun prot-modeline--first-char (str) - "Return first character from STR." - (substring str 0 1)) - -(defun prot-modeline-string-abbreviate (str) - "Abbreviate STR individual hyphen or underscore separated words. -Also see `prot-modeline-string-abbreviate-but-last'." - (if (prot-modeline--string-truncate-p str) - (mapconcat #'prot-modeline--first-char (split-string str "[_-]") "-") - str)) - -(defun prot-modeline-string-abbreviate-but-last (str nthlast) - "Abbreviate STR, keeping NTHLAST words intact. -Also see `prot-modeline-string-abbreviate'." - (if (prot-modeline--string-truncate-p str) - (let* ((all-strings (split-string str "[_-]")) - (nbutlast-strings (nbutlast (copy-sequence all-strings) nthlast)) - (last-strings (nreverse (ntake nthlast (nreverse (copy-sequence all-strings))))) - (first-component (mapconcat #'prot-modeline--first-char nbutlast-strings "-")) - (last-component (mapconcat #'identity last-strings "-"))) - (if (string-empty-p first-component) - last-component - (concat first-component "-" last-component))) - str)) - -;;;; Keyboard macro indicator - -(defvar-local prot-modeline-kbd-macro - '(:eval - (when (and (mode-line-window-selected-p) defining-kbd-macro) - (propertize " KMacro " 'face 'prot-modeline-indicator-blue-bg))) - "Mode line construct displaying `mode-line-defining-kbd-macro'. -Specific to the current window's mode line.") +*** EMMS Convenience functions +Somewhat related to [[id:3ca0c5a0-4829-4411-a80b-f2fe69650ea0][Elfeed/EMMS Youtube Code]]. -;;;; Narrow indicator - -(defvar-local prot-modeline-narrow - '(:eval - (when (and (mode-line-window-selected-p) - (buffer-narrowed-p) - (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) - (propertize " Narrow " 'face 'prot-modeline-indicator-cyan-bg))) - "Mode line construct to report the multilingual environment.") - -;;;; Centered cursor indicator -(defvar-local bard-modeline-centered-cursor - '(:eval - (when (and (mode-line-window-selected-p) - (bard/cursor-centered-p) - (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) - (propertize " Center " 'face 'prot-modeline-indicator-yellow-bg))) - "Mode line construct to report the multilingual environment.") - -;; FIXME: Combine these two functions one day... -(defvar-local bard-modeline-ryo-modal-normal - '(:eval - (when (and (mode-line-window-selected-p) - (not (bard/ryo-insert-p)) - (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) - (propertize "" 'face 'prot-modeline-indicator-magenta-bg)) - ) - "Mode line construct to show normal mode for ryo-modal.") - -(defvar-local bard-modeline-ryo-modal-insert - '(:eval - (when (and (mode-line-window-selected-p) - (bard/ryo-insert-p) - (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) - (propertize "" 'face 'prot-modeline-indicator-blue-bg)) - ) - "Mode line construct to show insert mode for ryo-modal.") +#+begin_src emacs-lisp :tangle bard-elisp/bard-media.el :mkdirp yes + (defun bard/play-youtube-video () + "Play the YouTube URL at point or prompt for one if none is found." + (interactive) + (let* ((url-at-point (thing-at-point 'url t)) + (url (if (and url-at-point + (string-match-p "https?://\\(www\\.\\)?\\(youtube\\.com\\|youtu\\.be\\)" url-at-point)) + url-at-point + (read-string "Enter YouTube URL: ")))) + (if (and url (string-match-p "https?://\\(www\\.\\)?\\(youtube\\.com\\|youtu\\.be\\)" url)) + (async-shell-command (format "mpv '%s'" url)) + (message "The URL is not a valid YouTube link: %s" url)))) + + (defun bard/save-emms-watch-later () + "Save the current EMMS playlist to `bard/watch-later-file` using `bard/emms-playlist-format`." + (interactive) + (when (and bard/watch-later-file bard/emms-playlist-format) + (emms-playlist-save bard/emms-playlist-format bard/watch-later-file) + (message "Playlist saved to %s" bard/watch-later-file))) + + (defun bard/emms-download-current-video (destination) + "Download the currently playing EMMS video and move it to DESTINATION." + (interactive "DSelect destination directory: ") + (require 'emms) + (let* ((track (emms-playlist-current-selected-track)) + (url (emms-track-get track 'name)) + (default-directory (file-name-as-directory temporary-file-directory)) + (downloader (executable-find "yt-dlp")) + (output-template "%(title)s.%(ext)s")) + (unless downloader + (error "yt-dlp or youtube-dl is not installed or not in PATH")) + (unless (string-match-p "^https?://" url) + (error "Current track is not a valid video URL")) + + (let ((cmd (format "%s -o \"%s\" \"%s\"" + downloader output-template url))) + (message "Downloading video from: %s" url) + (let ((exit-code (shell-command cmd))) + (if (not (eq exit-code 0)) + (error "Download failed, see *Messages* for details") + ;; Move the downloaded file + (let* ((downloaded-file (car (directory-files default-directory t ".*\\(mp4\\|mkv\\|webm\\)$" 'time))) + (target-path (expand-file-name (file-name-nondirectory downloaded-file) destination))) + (rename-file downloaded-file target-path t) + (message "Video saved to: %s" target-path))))))) +#+end_src -;;;; Input method +*** Interacting with ~nsxiv~ image browser through elisp +I made a video about this workflow [[https://www.youtube.com/watch?v=fEUQEK_uXk0][here]]. -(defvar-local prot-modeline-input-method - '(:eval - (when current-input-method-title - (propertize (format " %s " current-input-method-title) - 'face 'prot-modeline-indicator-green-bg - 'mouse-face 'mode-line-highlight))) - "Mode line construct to report the multilingual environment.") - -;;;; Buffer status -(defvar-local prot-modeline-buffer-status - '(:eval - (when (file-remote-p default-directory) - (propertize " @ " - 'face 'prot-modeline-indicator-red-bg - 'mouse-face 'mode-line-highlight))) - "Mode line construct for showing remote file name.") +#+begin_src emacs-lisp :tangle bard-elisp/bard-media.el :mkdirp yes + (defun bard/image-browser-choose (directory) + "Open nsxiv in thumbnail mode on DIRECTORY. + Asks the user whether to enable recursive mode and whether to output marked files to a buffer." + (interactive "DSelect directory: ") + (let* ((recursive (if (y-or-n-p "Recursive searching? ") "-r" "")) + (stdout (if (y-or-n-p "Output marked files to buffer? ") "-o" "")) + (full-dir (expand-file-name directory)) + (args (remove "" (list "nsxiv" "-t" stdout recursive full-dir)))) + ;; Pre-clear the output buffer if needed + (when (string= stdout "-o") + (with-current-buffer (get-buffer-create "*nsxiv*") + (read-only-mode 0) + (erase-buffer))) + + (message "Running: %s" (string-join args " ")) + + (let ((process (apply #'start-process "nsxiv" "*nsxiv*" args))) + (when (string= stdout "-o") + (set-process-sentinel + process + (lambda (proc event) + (when (string= event "finished\n") + (with-current-buffer "*nsxiv*" + (read-only-mode nil) + (goto-char (point-min))) + ;; Read marked files + (let ((files (with-current-buffer "*nsxiv*" + (split-string (buffer-string) "\n" t)))) + (bard/open-marked-in-dired files))))) + (pop-to-buffer "*nsxiv*"))))) + + (defun bard/open-marked-in-dired (files) + "Open a list of FILES in an interactive Dired buffer." + (if (and files (listp files)) + (dired (cons "*nsxiv-marked*" files)) + (message "No valid files to show in Dired."))) + + (defun bard/image-browser-marked () + "Open nsxiv on the marked files in Dired. + Assumes that files have already been validated." + (let ((files (dired-get-marked-files))) + (message "Opening marked files: %s" (string-join files ", ")) + (apply #'start-process "nsxiv" "*nsxiv*" "nsxiv" "-t" files))) + + (defun bard/image-browser () + "Open nsxiv in a context-sensitive way: + - If in Dired with marked files, open those with nsxiv. + - If in Dired with no marked files, prompt for a directory. + - If not in Dired, prompt for a directory." + (interactive) + (cond + ;; In Dired and files are marked + ((and (derived-mode-p 'dired-mode) + (< 1 (length (dired-get-marked-files)))) + (message "Opening marked files from Dired...") + (bard/image-browser-marked)) + + ;; In Dired but no marked files + ((derived-mode-p 'dired-mode) + (message "No files marked in Dired. Prompting for directory...") + (call-interactively #'bard/image-browser-choose)) + + ;; Not in Dired + (t + (message "Not in Dired. Prompting for directory...") + (call-interactively #'bard/image-browser-choose)))) -;;;; Dedicated window + (provide 'bard-media.el) +#+end_src -(defvar-local prot-modeline-window-dedicated-status - '(:eval - (when (window-dedicated-p) - (propertize " = " - 'face 'prot-modeline-indicator-magenta-bg - 'mouse-face 'mode-line-highlight))) - "Mode line construct for dedicated window indicator.") +** bard-modeline +This is another one of prot's libraries that I copied and modified a long time ago. The modifications this time were quite insignificant, but I did add some custom modules that I wanted. -;;;; Buffer name and modified status +#+begin_src emacs-lisp :tangle bard-elisp/bard-modeline.el :mkdirp yes + (require 'prot-common) + + (defgroup prot-modeline nil + "Custom modeline that is stylistically close to the default." + :group 'mode-line) + + (defgroup prot-modeline-faces nil + "Faces for my custom modeline." + :group 'prot-modeline) + + (defcustom prot-modeline-string-truncate-length 9 + "String length after which truncation should be done in small windows." + :type 'natnum) + + (defun mode-line-window-selected-p () + "Return non-nil if we're updating the mode line for the selected window. + This function is meant to be called in `:eval' mode line + constructs to allow altering the look of the mode line depending + on whether the mode line belongs to the currently selected window + or not." + (let ((window (selected-window))) + (or (eq window (old-selected-window)) + (and (minibuffer-window-active-p (minibuffer-window)) + (with-selected-window (minibuffer-window) + (eq window (minibuffer-selected-window))))))) + + ;;;; Faces + + (defface prot-modeline-indicator-button nil + "Generic face used for indicators that have a background. + Modify this face to, for example, add a :box attribute to all + relevant indicators (combines nicely with my `spacious-padding' + package).") + + (defface prot-modeline-indicator-red + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#880000") + (((class color) (min-colors 88) (background dark)) + :foreground "#ff9f9f") + (t :foreground "red")) + "Face for modeline indicators (e.g. see my `notmuch-indicator')." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-red-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#aa1111" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#ff9090" :foreground "black") + (t :background "red" :foreground "black")) + "Face for modeline indicators with a background." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-green + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#005f00") + (((class color) (min-colors 88) (background dark)) + :foreground "#73fa7f") + (t :foreground "green")) + "Face for modeline indicators (e.g. see my `notmuch-indicator')." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-green-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#207b20" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#77d077" :foreground "black") + (t :background "green" :foreground "black")) + "Face for modeline indicators with a background." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-yellow + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#6f4000") + (((class color) (min-colors 88) (background dark)) + :foreground "#f0c526") + (t :foreground "yellow")) + "Face for modeline indicators (e.g. see my `notmuch-indicator')." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-yellow-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#805000" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#ffc800" :foreground "black") + (t :background "yellow" :foreground "black")) + "Face for modeline indicators with a background." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-blue + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#00228a") + (((class color) (min-colors 88) (background dark)) + :foreground "#88bfff") + (t :foreground "blue")) + "Face for modeline indicators (e.g. see my `notmuch-indicator')." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-blue-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#0000aa" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#77aaff" :foreground "black") + (t :background "blue" :foreground "black")) + "Face for modeline indicators with a background." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-magenta + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#6a1aaf") + (((class color) (min-colors 88) (background dark)) + :foreground "#e0a0ff") + (t :foreground "magenta")) + "Face for modeline indicators (e.g. see my `notmuch-indicator')." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-magenta-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#6f0f9f" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#e3a2ff" :foreground "black") + (t :background "magenta" :foreground "black")) + "Face for modeline indicators with a background." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-cyan + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#004060") + (((class color) (min-colors 88) (background dark)) + :foreground "#30b7cc") + (t :foreground "cyan")) + "Face for modeline indicators (e.g. see my `notmuch-indicator')." + :group 'prot-modeline-faces) + + (defface prot-modeline-indicator-cyan-bg + '((default :inherit (bold prot-modeline-indicator-button)) + (((class color) (min-colors 88) (background light)) + :background "#006080" :foreground "white") + (((class color) (min-colors 88) (background dark)) + :background "#40c0e0" :foreground "black") + (t :background "cyan" :foreground "black")) + "Face for modeline indicators with a background." + :group 'prot-modeline-faces) + + ;;;; Common helper functions + + (defun prot-modeline--string-truncate-p (str) + "Return non-nil if STR should be truncated." + (and (prot-common-window-small-p) + (> (length str) prot-modeline-string-truncate-length) + (not (one-window-p :no-minibuffer)))) + + (defun prot-modeline--truncate-p () + "Return non-nil if truncation should happen. + This is a more general and less stringent variant of + `prot-modeline--string-truncate-p'." + (and (prot-common-window-small-p) + (not (one-window-p :no-minibuffer)))) + + (defun prot-modeline-string-truncate (str) + "Return truncated STR, if appropriate, else return STR. + Truncation is done up to `prot-modeline-string-truncate-length'." + (if (prot-modeline--string-truncate-p str) + (concat (substring str 0 prot-modeline-string-truncate-length) "...") + str)) + + (defun prot-modeline-string-truncate-end (str) + "Like `prot-modeline-string-truncate' but truncate from STR beginning." + (if (prot-modeline--string-truncate-p str) + (concat "..." (substring str (- prot-modeline-string-truncate-length))) + str)) + + (defun prot-modeline--first-char (str) + "Return first character from STR." + (substring str 0 1)) + + (defun prot-modeline-string-abbreviate (str) + "Abbreviate STR individual hyphen or underscore separated words. + Also see `prot-modeline-string-abbreviate-but-last'." + (if (prot-modeline--string-truncate-p str) + (mapconcat #'prot-modeline--first-char (split-string str "[_-]") "-") + str)) + + (defun prot-modeline-string-abbreviate-but-last (str nthlast) + "Abbreviate STR, keeping NTHLAST words intact. + Also see `prot-modeline-string-abbreviate'." + (if (prot-modeline--string-truncate-p str) + (let* ((all-strings (split-string str "[_-]")) + (nbutlast-strings (nbutlast (copy-sequence all-strings) nthlast)) + (last-strings (nreverse (ntake nthlast (nreverse (copy-sequence all-strings))))) + (first-component (mapconcat #'prot-modeline--first-char nbutlast-strings "-")) + (last-component (mapconcat #'identity last-strings "-"))) + (if (string-empty-p first-component) + last-component + (concat first-component "-" last-component))) + str)) + + ;;;; Keyboard macro indicator + + (defvar-local prot-modeline-kbd-macro + '(:eval + (when (and (mode-line-window-selected-p) defining-kbd-macro) + (propertize " KMacro " 'face 'prot-modeline-indicator-blue-bg))) + "Mode line construct displaying `mode-line-defining-kbd-macro'. + Specific to the current window's mode line.") + + ;;;; Narrow indicator + + (defvar-local prot-modeline-narrow + '(:eval + (when (and (mode-line-window-selected-p) + (buffer-narrowed-p) + (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) + (propertize " Narrow " 'face 'prot-modeline-indicator-cyan-bg))) + "Mode line construct to report the multilingual environment.") + + ;;;; Centered cursor indicator + (defvar-local bard-modeline-centered-cursor + '(:eval + (when (and (mode-line-window-selected-p) + (bard/cursor-centered-p) + (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) + (propertize " Center " 'face 'prot-modeline-indicator-yellow-bg))) + "Mode line construct to report the multilingual environment.") + + ;; FIXME: Combine these two functions one day... + (defvar-local bard-modeline-ryo-modal-normal + '(:eval + (when (and (mode-line-window-selected-p) + (not (bard/ryo-insert-p)) + (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) + (propertize "" 'face 'prot-modeline-indicator-magenta-bg)) + ) + "Mode line construct to show normal mode for ryo-modal.") + + (defvar-local bard-modeline-ryo-modal-insert + '(:eval + (when (and (mode-line-window-selected-p) + (bard/ryo-insert-p) + (not (derived-mode-p 'Info-mode 'help-mode 'special-mode 'message-mode))) + (propertize "" 'face 'prot-modeline-indicator-blue-bg)) + ) + "Mode line construct to show insert mode for ryo-modal.") + + ;;;; Input method + + (defvar-local prot-modeline-input-method + '(:eval + (when current-input-method-title + (propertize (format " %s " current-input-method-title) + 'face 'prot-modeline-indicator-green-bg + 'mouse-face 'mode-line-highlight))) + "Mode line construct to report the multilingual environment.") + + ;;;; Buffer status + (defvar-local prot-modeline-buffer-status + '(:eval + (when (file-remote-p default-directory) + (propertize " @ " + 'face 'prot-modeline-indicator-red-bg + 'mouse-face 'mode-line-highlight))) + "Mode line construct for showing remote file name.") + + ;;;; Dedicated window + + (defvar-local prot-modeline-window-dedicated-status + '(:eval + (when (window-dedicated-p) + (propertize " = " + 'face 'prot-modeline-indicator-magenta-bg + 'mouse-face 'mode-line-highlight))) + "Mode line construct for dedicated window indicator.") + + ;;;; Buffer name and modified status + + (defun prot-modeline-buffer-identification-face () + "Return appropriate face or face list for `prot-modeline-buffer-identification'." + (let ((file (buffer-file-name))) + (cond + ((and (mode-line-window-selected-p) + file + (buffer-modified-p)) + '(error italic mode-line-buffer-id)) + ((and file (buffer-modified-p)) + 'italic) + ((mode-line-window-selected-p) + 'mode-line-buffer-id)))) + + (defun prot-modeline--buffer-name () + "Return `buffer-name', truncating it if necessary. + See `prot-modeline-string-truncate'." + (when-let ((name (buffer-name))) + (prot-modeline-string-truncate name))) + + (defun prot-modeline-buffer-name () + "Return buffer name, with read-only indicator if relevant." + (let ((name (prot-modeline--buffer-name))) + (if buffer-read-only + (format "%s %s" (char-to-string #xE0A2) name) + name))) + + (defun prot-modeline-buffer-name-help-echo () + "Return `help-echo' value for `prot-modeline-buffer-identification'." + (concat + (propertize (buffer-name) 'face 'mode-line-buffer-id) + "\n" + (propertize + (or (buffer-file-name) + (format "No underlying file.\nDirectory is: %s" default-directory)) + 'face 'font-lock-doc-face))) + + (defvar-local prot-modeline-buffer-identification + '(:eval + (propertize (prot-modeline-buffer-name) + 'face (prot-modeline-buffer-identification-face) + 'mouse-face 'mode-line-highlight + 'help-echo (prot-modeline-buffer-name-help-echo))) + "Mode line construct for identifying the buffer being displayed. + Propertize the current buffer with the `mode-line-buffer-id' + face. Let other buffers have no face.") + + ;;;; Major mode + + (defun prot-modeline-major-mode-indicator () + "Return appropriate propertized mode line indicator for the major mode." + (let ((indicator (cond + ((derived-mode-p 'text-mode) "§") + ((derived-mode-p 'prog-mode) "λ") + ((derived-mode-p 'term-mode) ">_") + ((derived-mode-p 'emms-playlist-mode) "♪") + (t "◦")))) + (propertize indicator 'face 'shadow))) + + (defun prot-modeline-major-mode-name () + "Return capitalized `major-mode' without the -mode suffix." + (capitalize (string-replace "-mode" "" (symbol-name major-mode)))) + + (defun prot-modeline-major-mode-help-echo () + "Return `help-echo' value for `prot-modeline-major-mode'." + (if-let ((parent (get major-mode 'derived-mode-parent))) + (format "Symbol: `%s'. Derived from: `%s'" major-mode parent) + (format "Symbol: `%s'." major-mode))) + + (defvar-local prot-modeline-major-mode + (list + (propertize "%[" 'face 'prot-modeline-indicator-red) + '(:eval + (concat + (prot-modeline-major-mode-indicator) + " " + (propertize + (prot-modeline-string-abbreviate-but-last + (prot-modeline-major-mode-name) + 2) + 'mouse-face 'mode-line-highlight + 'help-echo (prot-modeline-major-mode-help-echo)))) + (propertize "%]" 'face 'prot-modeline-indicator-red)) + "Mode line construct for displaying major modes.") + + (defvar-local prot-modeline-process + (list '("" mode-line-process)) + "Mode line construct for the running process indicator.") + + ;;;; Git branch and diffstat + + (declare-function vc-git--symbolic-ref "vc-git" (file)) + + (defun prot-modeline--vc-branch-name (file backend) + "Return capitalized VC branch name for FILE with BACKEND." + (when-let ((rev (vc-working-revision file backend)) + (branch (or (vc-git--symbolic-ref file) + (substring rev 0 7)))) + (capitalize branch))) + + (declare-function vc-git-working-revision "vc-git" (file)) + + (defvar prot-modeline-vc-map + (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] 'vc-diff) + (define-key map [mode-line down-mouse-3] 'vc-root-diff) + map) + "Keymap to display on VC indicator.") + + (defun prot-modeline--vc-help-echo (file) + "Return `help-echo' message for FILE tracked by VC." + (format "Revision: %s\nmouse-1: `vc-diff'\nmouse-3: `vc-root-diff'" + (vc-working-revision file))) + + (defun prot-modeline--vc-text (file branch &optional face) + "Prepare text for Git controlled FILE, given BRANCH. + With optional FACE, use it to propertize the BRANCH." + (concat + (propertize (char-to-string #xE0A0) 'face 'shadow) + " " + (propertize branch + 'face face + 'mouse-face 'mode-line-highlight + 'help-echo (prot-modeline--vc-help-echo file) + 'local-map prot-modeline-vc-map) + ;; " " + ;; (prot-modeline-diffstat file) + )) -(defun prot-modeline-buffer-identification-face () - "Return appropriate face or face list for `prot-modeline-buffer-identification'." - (let ((file (buffer-file-name))) - (cond - ((and (mode-line-window-selected-p) - file - (buffer-modified-p)) - '(error italic mode-line-buffer-id)) - ((and file (buffer-modified-p)) - 'italic) - ((mode-line-window-selected-p) - 'mode-line-buffer-id)))) - -(defun prot-modeline--buffer-name () - "Return `buffer-name', truncating it if necessary. -See `prot-modeline-string-truncate'." - (when-let ((name (buffer-name))) - (prot-modeline-string-truncate name))) - -(defun prot-modeline-buffer-name () - "Return buffer name, with read-only indicator if relevant." - (let ((name (prot-modeline--buffer-name))) - (if buffer-read-only - (format "%s %s" (char-to-string #xE0A2) name) - name))) - -(defun prot-modeline-buffer-name-help-echo () - "Return `help-echo' value for `prot-modeline-buffer-identification'." - (concat - (propertize (buffer-name) 'face 'mode-line-buffer-id) - "\n" - (propertize - (or (buffer-file-name) - (format "No underlying file.\nDirectory is: %s" default-directory)) - 'face 'font-lock-doc-face))) - -(defvar-local prot-modeline-buffer-identification - '(:eval - (propertize (prot-modeline-buffer-name) - 'face (prot-modeline-buffer-identification-face) - 'mouse-face 'mode-line-highlight - 'help-echo (prot-modeline-buffer-name-help-echo))) - "Mode line construct for identifying the buffer being displayed. -Propertize the current buffer with the `mode-line-buffer-id' -face. Let other buffers have no face.") - -;;;; Major mode - -(defun prot-modeline-major-mode-indicator () - "Return appropriate propertized mode line indicator for the major mode." - (let ((indicator (cond - ((derived-mode-p 'text-mode) "§") - ((derived-mode-p 'prog-mode) "λ") - ((derived-mode-p 'term-mode) ">_") - ((derived-mode-p 'emms-playlist-mode) "♪") - (t "◦")))) - (propertize indicator 'face 'shadow))) - -(defun prot-modeline-major-mode-name () - "Return capitalized `major-mode' without the -mode suffix." - (capitalize (string-replace "-mode" "" (symbol-name major-mode)))) - -(defun prot-modeline-major-mode-help-echo () - "Return `help-echo' value for `prot-modeline-major-mode'." - (if-let ((parent (get major-mode 'derived-mode-parent))) - (format "Symbol: `%s'. Derived from: `%s'" major-mode parent) - (format "Symbol: `%s'." major-mode))) - -(defvar-local prot-modeline-major-mode - (list - (propertize "%[" 'face 'prot-modeline-indicator-red) - '(:eval - (concat - (prot-modeline-major-mode-indicator) - " " - (propertize - (prot-modeline-string-abbreviate-but-last - (prot-modeline-major-mode-name) - 2) - 'mouse-face 'mode-line-highlight - 'help-echo (prot-modeline-major-mode-help-echo)))) - (propertize "%]" 'face 'prot-modeline-indicator-red)) - "Mode line construct for displaying major modes.") - -(defvar-local prot-modeline-process - (list '("" mode-line-process)) - "Mode line construct for the running process indicator.") - -;;;; Git branch and diffstat - -(declare-function vc-git--symbolic-ref "vc-git" (file)) - -(defun prot-modeline--vc-branch-name (file backend) - "Return capitalized VC branch name for FILE with BACKEND." - (when-let ((rev (vc-working-revision file backend)) - (branch (or (vc-git--symbolic-ref file) - (substring rev 0 7)))) - (capitalize branch))) - -;; NOTE 2023-07-27: This is a good idea, but it hardcodes Git, whereas -;; I want a generic VC method. Granted, I only use Git but I still -;; want it to work as a VC extension. - -;; (defun prot-modeline-diffstat (file) -;; "Return shortened Git diff numstat for FILE." -;; (when-let* ((output (shell-command-to-string (format "git diff --numstat %s" file))) -;; (stats (split-string output "[\s\t]" :omit-nulls "[\s\f\t\n\r\v]+")) -;; (added (nth 0 stats)) -;; (deleted (nth 1 stats))) -;; (cond -;; ((and (equal added "0") (equal deleted "0")) -;; "") -;; ((and (not (equal added "0")) (equal deleted "0")) -;; (propertize (format "+%s" added) 'face 'shadow)) -;; ((and (equal added "0") (not (equal deleted "0"))) -;; (propertize (format "-%s" deleted) 'face 'shadow)) -;; (t -;; (propertize (format "+%s -%s" added deleted) 'face 'shadow))))) - -(declare-function vc-git-working-revision "vc-git" (file)) - -(defvar prot-modeline-vc-map - (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] 'vc-diff) - (define-key map [mode-line down-mouse-3] 'vc-root-diff) - map) - "Keymap to display on VC indicator.") - -(defun prot-modeline--vc-help-echo (file) - "Return `help-echo' message for FILE tracked by VC." - (format "Revision: %s\nmouse-1: `vc-diff'\nmouse-3: `vc-root-diff'" - (vc-working-revision file))) - -(defun prot-modeline--vc-text (file branch &optional face) - "Prepare text for Git controlled FILE, given BRANCH. -With optional FACE, use it to propertize the BRANCH." - (concat - (propertize (char-to-string #xE0A0) 'face 'shadow) - " " - (propertize branch - 'face face - 'mouse-face 'mode-line-highlight - 'help-echo (prot-modeline--vc-help-echo file) - 'local-map prot-modeline-vc-map) - ;; " " - ;; (prot-modeline-diffstat file) - )) - -(defun prot-modeline--vc-details (file branch &optional face) - "Return Git BRANCH details for FILE, truncating it if necessary. -The string is truncated if the width of the window is smaller -than `split-width-threshold'." - (prot-modeline-string-truncate - (prot-modeline--vc-text file branch face))) - -(defvar prot-modeline--vc-faces - '((added . vc-locally-added-state) - (edited . vc-edited-state) - (removed . vc-removed-state) - (missing . vc-missing-state) - (conflict . vc-conflict-state) - (locked . vc-locked-state) - (up-to-date . vc-up-to-date-state)) - "VC state faces.") - -(defun prot-modeline--vc-get-face (key) - "Get face from KEY in `prot-modeline--vc-faces'." - (alist-get key prot-modeline--vc-faces 'up-to-date)) - -(defun prot-modeline--vc-face (file backend) - "Return VC state face for FILE with BACKEND." - (prot-modeline--vc-get-face (vc-state file backend))) - -(defvar-local prot-modeline-vc-branch + (defun prot-modeline--vc-details (file branch &optional face) + "Return Git BRANCH details for FILE, truncating it if necessary. + The string is truncated if the width of the window is smaller + than `split-width-threshold'." + (prot-modeline-string-truncate + (prot-modeline--vc-text file branch face))) + + (defvar prot-modeline--vc-faces + '((added . vc-locally-added-state) + (edited . vc-edited-state) + (removed . vc-removed-state) + (missing . vc-missing-state) + (conflict . vc-conflict-state) + (locked . vc-locked-state) + (up-to-date . vc-up-to-date-state)) + "VC state faces.") + + (defun prot-modeline--vc-get-face (key) + "Get face from KEY in `prot-modeline--vc-faces'." + (alist-get key prot-modeline--vc-faces 'up-to-date)) + + (defun prot-modeline--vc-face (file backend) + "Return VC state face for FILE with BACKEND." + (prot-modeline--vc-get-face (vc-state file backend))) + + (defvar-local prot-modeline-vc-branch + '(:eval + (when-let* (((mode-line-window-selected-p)) + (file (buffer-file-name)) + (backend (vc-backend file)) + ;; ((vc-git-registered file)) + (branch (prot-modeline--vc-branch-name file backend)) + (face (prot-modeline--vc-face file backend))) + (prot-modeline--vc-details file branch face))) + "Mode line construct to return propertized VC branch.") + + ;;;; Flymake errors, warnings, notes + + (declare-function flymake--severity "flymake" (type)) + (declare-function flymake-diagnostic-type "flymake" (diag)) + + ;; Based on `flymake--mode-line-counter'. + (defun prot-modeline-flymake-counter (type) + "Compute number of diagnostics in buffer with TYPE's severity. + TYPE is usually keyword `:error', `:warning' or `:note'." + (let ((count 0)) + (dolist (d (flymake-diagnostics)) + (when (= (flymake--severity type) + (flymake--severity (flymake-diagnostic-type d))) + (cl-incf count))) + (when (cl-plusp count) + (number-to-string count)))) + + (defvar prot-modeline-flymake-map + (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] 'flymake-show-buffer-diagnostics) + (define-key map [mode-line down-mouse-3] 'flymake-show-project-diagnostics) + map) + "Keymap to display on Flymake indicator.") + + (defmacro prot-modeline-flymake-type (type indicator &optional face) + "Return function that handles Flymake TYPE with stylistic INDICATOR and FACE." + `(defun ,(intern (format "prot-modeline-flymake-%s" type)) () + (when-let ((count (prot-modeline-flymake-counter + ,(intern (format ":%s" type))))) + (concat + (propertize ,indicator 'face 'shadow) + (propertize count + 'face ',(or face type) + 'mouse-face 'mode-line-highlight + ;; FIXME 2023-07-03: Clicking on the text with + ;; this buffer and a single warning present, the + ;; diagnostics take up the entire frame. Why? + 'local-map prot-modeline-flymake-map + 'help-echo "mouse-1: buffer diagnostics\nmouse-3: project diagnostics"))))) + + (prot-modeline-flymake-type error "☣") + (prot-modeline-flymake-type warning "!") + (prot-modeline-flymake-type note "·" success) + + (defvar-local prot-modeline-flymake + `(:eval + (when (and (bound-and-true-p flymake-mode) + (mode-line-window-selected-p)) + (list + ;; See the calls to the macro `prot-modeline-flymake-type' + '(:eval (prot-modeline-flymake-error)) + '(:eval (prot-modeline-flymake-warning)) + '(:eval (prot-modeline-flymake-note))))) + "Mode line construct displaying `flymake-mode-line-format'. + Specific to the current window's mode line.") + + (with-eval-after-load 'eglot + (setq mode-line-misc-info + (delete '(eglot--managed-mode (" [" eglot--mode-line-format "] ")) mode-line-misc-info))) + + (defvar-local prot-modeline-eglot + `(:eval + (when (and (featurep 'eglot) (mode-line-window-selected-p)) + '(eglot--managed-mode eglot--mode-line-format))) + "Mode line construct displaying Eglot information. + Specific to the current window's mode line.") + + (defvar-local prot-modeline-notmuch-indicator + '(notmuch-indicator-mode + (" " + (:eval (when (mode-line-window-selected-p) + notmuch-indicator--counters)))) + "The equivalent of `notmuch-indicator-mode-line-construct'. + Display the indicator only on the focused window's mode line.") + + (defvar-local bard-evil-state-indicator '(:eval - (when-let* (((mode-line-window-selected-p)) - (file (buffer-file-name)) - (backend (vc-backend file)) - ;; ((vc-git-registered file)) - (branch (prot-modeline--vc-branch-name file backend)) - (face (prot-modeline--vc-face file backend))) - (prot-modeline--vc-details file branch face))) - "Mode line construct to return propertized VC branch.") - -;;;; Flymake errors, warnings, notes - -(declare-function flymake--severity "flymake" (type)) -(declare-function flymake-diagnostic-type "flymake" (diag)) - -;; Based on `flymake--mode-line-counter'. -(defun prot-modeline-flymake-counter (type) - "Compute number of diagnostics in buffer with TYPE's severity. -TYPE is usually keyword `:error', `:warning' or `:note'." - (let ((count 0)) - (dolist (d (flymake-diagnostics)) - (when (= (flymake--severity type) - (flymake--severity (flymake-diagnostic-type d))) - (cl-incf count))) - (when (cl-plusp count) - (number-to-string count)))) - -(defvar prot-modeline-flymake-map - (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] 'flymake-show-buffer-diagnostics) - (define-key map [mode-line down-mouse-3] 'flymake-show-project-diagnostics) - map) - "Keymap to display on Flymake indicator.") - -(defmacro prot-modeline-flymake-type (type indicator &optional face) - "Return function that handles Flymake TYPE with stylistic INDICATOR and FACE." - `(defun ,(intern (format "prot-modeline-flymake-%s" type)) () - (when-let ((count (prot-modeline-flymake-counter - ,(intern (format ":%s" type))))) - (concat - (propertize ,indicator 'face 'shadow) - (propertize count - 'face ',(or face type) - 'mouse-face 'mode-line-highlight - ;; FIXME 2023-07-03: Clicking on the text with - ;; this buffer and a single warning present, the - ;; diagnostics take up the entire frame. Why? - 'local-map prot-modeline-flymake-map - 'help-echo "mouse-1: buffer diagnostics\nmouse-3: project diagnostics"))))) - -(prot-modeline-flymake-type error "☣") -(prot-modeline-flymake-type warning "!") -(prot-modeline-flymake-type note "·" success) - -(defvar-local prot-modeline-flymake - `(:eval - (when (and (bound-and-true-p flymake-mode) + (when (and (bound-and-true-p evil-local-mode) (mode-line-window-selected-p)) - (list - ;; See the calls to the macro `prot-modeline-flymake-type' - '(:eval (prot-modeline-flymake-error)) - '(:eval (prot-modeline-flymake-warning)) - '(:eval (prot-modeline-flymake-note))))) - "Mode line construct displaying `flymake-mode-line-format'. -Specific to the current window's mode line.") - -(with-eval-after-load 'eglot - (setq mode-line-misc-info - (delete '(eglot--managed-mode (" [" eglot--mode-line-format "] ")) mode-line-misc-info))) - -(defvar-local prot-modeline-eglot - `(:eval - (when (and (featurep 'eglot) (mode-line-window-selected-p)) - '(eglot--managed-mode eglot--mode-line-format))) - "Mode line construct displaying Eglot information. -Specific to the current window's mode line.") - -(defvar-local prot-modeline-notmuch-indicator - '(notmuch-indicator-mode - (" " - (:eval (when (mode-line-window-selected-p) - notmuch-indicator--counters)))) - "The equivalent of `notmuch-indicator-mode-line-construct'. -Display the indicator only on the focused window's mode line.") - -(defvar-local bard-evil-state-indicator - '(:eval - (when (and (bound-and-true-p evil-local-mode) - (mode-line-window-selected-p)) - (let ((state-label - (pcase evil-state - ('normal (propertize " " 'face 'prot-modeline-indicator-green)) - ('insert (propertize " " 'face 'prot-modeline-indicator-blue)) - ('visual (propertize " " 'face 'prot-modeline-indicator-yellow)) - ('replace (propertize " " 'face 'prot-modeline-indicator-red)) - ('emacs (propertize " " 'face 'prot-modeline-indicator-magenta)) - ('motion (propertize " " 'face 'prot-modeline-indicator-cyan)) - (_ (propertize " <> " 'face 'shadow))))) - state-label))) - "Modeline indicator for current Evil state.") - -;;;; Miscellaneous - -(defvar-local prot-modeline-misc-info - '(:eval - (when (mode-line-window-selected-p) - mode-line-misc-info)) - "Mode line construct displaying `mode-line-misc-info'. -Specific to the current window's mode line.") - -;;;; Risky local variables - -;; NOTE 2023-04-28: The `risky-local-variable' is critical, as those -;; variables will not work without it. -(dolist (construct '(prot-modeline-kbd-macro - prot-modeline-narrow - bard-modeline-centered-cursor - bard-evil-state-indicator - prot-modeline-input-method - prot-modeline-buffer-status - prot-modeline-window-dedicated-status - prot-modeline-evil - prot-modeline-buffer-identification - prot-modeline-major-mode - prot-modeline-process - prot-modeline-vc-branch - prot-modeline-flymake - prot-modeline-eglot - prot-modeline-misc-info - prot-modeline-notmuch-indicator)) - (put construct 'risky-local-variable t)) - -(provide 'bard-modeline) - + (let ((state-label + (pcase evil-state + ('normal (propertize " " 'face 'prot-modeline-indicator-green)) + ('insert (propertize " " 'face 'prot-modeline-indicator-blue)) + ('visual (propertize " " 'face 'prot-modeline-indicator-yellow)) + ('replace (propertize " " 'face 'prot-modeline-indicator-red)) + ('emacs (propertize " " 'face 'prot-modeline-indicator-magenta)) + ('motion (propertize " " 'face 'prot-modeline-indicator-cyan)) + (_ (propertize " <> " 'face 'shadow))))) + state-label))) + "Modeline indicator for current Evil state.") + + ;;;; Miscellaneous + + (defvar-local prot-modeline-misc-info + '(:eval + (when (mode-line-window-selected-p) + mode-line-misc-info)) + "Mode line construct displaying `mode-line-misc-info'. + Specific to the current window's mode line.") + + ;;;; Risky local variables + + ;; NOTE 2023-04-28: The `risky-local-variable' is critical, as those + ;; variables will not work without it. + (dolist (construct '(prot-modeline-kbd-macro + prot-modeline-narrow + bard-modeline-centered-cursor + bard-evil-state-indicator + prot-modeline-input-method + prot-modeline-buffer-status + prot-modeline-window-dedicated-status + prot-modeline-evil + prot-modeline-buffer-identification + prot-modeline-major-mode + prot-modeline-process + prot-modeline-vc-branch + prot-modeline-flymake + prot-modeline-eglot + prot-modeline-misc-info + prot-modeline-notmuch-indicator)) + (put construct 'risky-local-variable t)) + + (provide 'bard-modeline) #+end_src ** bard-package +I renamed the functions from [[https://manueluberti.eu/posts/2021-09-01-package-report/][this post]] because otherwise I would forget I had them in my system. I keep personal/custom functions prefixed with ~bard/~ so I can look at them through minibuffer if I forgot the name. This shows me that they are not part of default Emacs. #+begin_src emacs-lisp :tangle bard-elisp/bard-package.el :mkdirp yes -;; taken and renamed functions from https://manueluberti.eu/posts/2021-09-01-package-report/ +;; taken and renamed functions from (defun bard/package-report () "Report total package counts grouped by archive." @@ -3588,64 +3686,71 @@ packages installed from each archive." #+end_src ** bard-theme +*** Fontaine font presets +The main configuration for fontaine is found at [[id:542a0f2e-f79e-4272-af55-284c81b16fc3][bard-emacs-theme::Fonts]]. These are the presets for different fonts that I can switch between using ~C-c f~. + #+begin_src emacs-lisp :tangle bard-elisp/bard-theme.el :mkdirp yes (setq fontaine-presets - '((default - :default-height 140 - :default-family "Iosevka Comfy" - :variable-pitch-family "Iosevka Comfy" - :variable-pitch-height 1.0 - :fixed-pitch-family "Iosevka Comfy" - :fixed-pitch-height 1.0 - :bold-weight bold - ) - (tiny - :inherit default - :default-height 135) - (wide - :default-height 135 - :default-family "Iosevka Comfy Wide" - :fixed-pitch-family "Iosevka Comfy Wide" - :variable-pitch-family "Iosevka Comfy Wide Motion Duo") - (prot - :default-family "Iosevka Comfy Wide Motion" - :default-height 130 - :default-weight medium - :fixed-pitch-family "Iosevka Comfy Wide Motion" - :variable-pitch-family "Iosevka Comfy Wide Duo" - :bold-weight extrabold) - (mono - :default-height 130 - :default-family "monospace" - :fixed-pitch-family "monospace" - :variable-pitch-family "Baskerville" - :variable-pitch-height 140) - (mono-large - :inherit mono - :default-height 150 - :variable-pitch-height 160) - (mac - :default-height 130 - :default-family "Monaco" - :variable-pitch-family "Monaco" - :fixed-pitch-family "Monaco") - (large - :inherit default - :default-height 160 - ) - (huge - :inherit default - :default-height 180 - ) - (t - :default-family "Monospace" - ))) + '((default + :default-height 140 + :default-family "Iosevka Comfy" + :variable-pitch-family "Iosevka Comfy" + :variable-pitch-height 1.0 + :fixed-pitch-family "Iosevka Comfy" + :fixed-pitch-height 1.0 + :bold-weight bold + ) + (tiny + :inherit default + :default-height 135) + (wide + :default-height 135 + :default-family "Iosevka Comfy Wide" + :fixed-pitch-family "Iosevka Comfy Wide" + :variable-pitch-family "Iosevka Comfy Wide Motion Duo") + (prot + :default-family "Iosevka Comfy Wide Motion" + :default-height 130 + :default-weight medium + :fixed-pitch-family "Iosevka Comfy Wide Motion" + :variable-pitch-family "Iosevka Comfy Wide Duo" + :bold-weight extrabold) + (mono + :default-height 130 + :default-family "monospace" + :fixed-pitch-family "monospace" + :variable-pitch-family "Baskerville" + :variable-pitch-height 140) + (mono-large + :inherit mono + :default-height 150 + :variable-pitch-height 160) + (mac + :default-height 130 + :default-family "Monaco" + :variable-pitch-family "Monaco" + :fixed-pitch-family "Monaco") + (large + :inherit default + :default-height 160) + (huge + :inherit default + :default-height 180) + (t + :default-family "Monospace"))) +#+end_src + +*** Japanese CJK font +Explanation provided by [[https://tatsumoto-ren.github.io/blog/japanese-fonts.html][AJATT — Japanese fonts]]. Essentially: Chinese fonts and Japanese fonts look different for certain Kanji. Since I don't want Chinese glyphs prioritized in Emacs over Japanese ones, I set the font to the Japanese (JP) version of Noto CJK font which is a very accessible and popular font for Asian languages. +#+begin_src emacs-lisp :tangle bard-elisp/bard-theme.el :mkdirp yes (set-fontset-font t 'han (font-spec :family "Noto Serif CJK JP") nil 'prepend) +#+end_src - ;;; Switching themes +*** Switching themes +#+begin_src emacs-lisp :tangle bard-elisp/bard-theme.el :mkdirp yes (defun bard/disable-all-themes () "disable all active themes." (interactive) @@ -3675,26 +3780,10 @@ packages installed from each archive." (load-theme theme-symbol t) (message "Loaded the %s theme" colored-theme-name) (run-hooks 'bard/after-theme-load-hook))) +#+end_src - (defun bard/update-ryo-cursor-color () - "Update the color variable of `ryo-modal-mode' cursor to match the ef/modus theme." - (let ((active-theme (car custom-enabled-themes)) - (cursor-color nil)) - (cond - ((and (fboundp 'ef-themes-with-colors) - (string-prefix-p "ef-" (symbol-name active-theme))) - (ef-themes-with-colors - (setq ryo-modal-cursor-color cursor - ryo-modal-default-cursor-color cursor))) - ((and (fboundp 'modus-themes-with-colors) - (string-prefix-p "modus-" (symbol-name active-theme))) - (modus-themes-with-colors - (setq ryo-modal-cursor-color cursor - ryo-modal-default-cursor-color cursor))) - (t (setq cursor-color "red")) - (setq ryo-modal-cursor-color cursor-color - ryo-modal-default-cursor-color cursor-color)))) - +*** Updating cursor for text mode +#+begin_src emacs-lisp :tangle bard-elisp/bard-theme.el :mkdirp yes (defvar my-last-cursor-type nil) (defun bard/update-cursor-type () @@ -3707,7 +3796,10 @@ packages installed from each archive." (setq my-last-cursor-type new-cursor))))) (add-hook 'post-command-hook #'bard/update-cursor-type) +#+end_src +*** Heading faces +#+begin_src emacs-lisp :tangle bard-elisp/bard-theme.el :mkdirp yes (defun bard/outline-heading-faces () (set-face-attribute 'org-document-title nil :inherit '(outline-1 variable-pitch) @@ -3750,433 +3842,437 @@ packages installed from each archive." :height 1.5)) (add-hook 'bard/after-theme-load-hook #'bard/outline-heading-faces) +#+end_src +*** Provide library +#+begin_src emacs-lisp :tangle bard-elisp/bard-theme.el :mkdirp yes (provide 'bard-theme) - #+end_src ** bard-web +*** Load required libraries #+begin_src emacs-lisp :tangle bard-elisp/bard-web.el :mkdirp yes -(require 'emms) -(require 'elfeed-search) + (require 'emms) + (require 'elfeed-search) +#+end_src -(defun bard/play-elfeed-video () - "Play the URL of the entry at point in mpv if it's a YouTube video." - (interactive) - (let ((entry (elfeed-search-selected :single))) - (if entry - (let ((url (elfeed-entry-link entry))) - (if (and url (string-match-p "https?://\\(www\\.\\)?youtube\\.com\\|youtu\\.be" url)) - (progn - (async-shell-command (format "mpv '%s'" url)) - (elfeed-search-untag-all-unread)) - (message "The URL is not a YouTube link: %s" url))) - (message "No entry selected in Elfeed.")))) - -(defun bard/add-video-emms-queue () - "Play the URL of the entry at point in mpv if it's a YouTube video. Add it to EMMS queue." - (interactive) - (let ((entry (elfeed-search-selected :single))) - (if entry - (let ((url (elfeed-entry-link entry))) - (if (and url (string-match-p "https?://\\(www\\.\\)?youtube\\.com\\|youtu\\.be" url)) - (let* ((playlist-name "Watch Later") - (playlist-buffer (get-buffer (format " *%s*" playlist-name)))) - (unless playlist-buffer - (setq playlist-buffer (emms-playlist-new (format " *%s*" playlist-name)))) - (emms-playlist-set-playlist-buffer playlist-buffer) - (emms-add-url url) - (elfeed-search-untag-all-unread) - (message "Added YouTube video to EMMS playlist: %s" url)) - (message "The URL is not a YouTube link: %s" url))) - (message "No entry selected in Elfeed.")))) - -(defun bard/add-video-watch-later () - "Add the current Elfeed YouTube entry URL to '~/Videos/watch-later.m3u' and mark it as read." - (interactive) - (let ((entry (elfeed-search-selected :single))) - (if entry - (let* ((url (elfeed-entry-link entry)) - (watch-later-file (expand-file-name "~/Videos/watch-later.m3u"))) - (if (and url (string-match-p "https?://\\(www\\.\\)?youtube\\.com\\|youtu\\.be" url)) - (progn - (with-temp-buffer - (insert (concat url "\n")) - (append-to-file (point-min) (point-max) watch-later-file)) - ;; Remove the 'unread tag from the entry directly - (setf (elfeed-entry-tags entry) - (remove 'unread (elfeed-entry-tags entry))) - ;; Force UI update - (when (derived-mode-p 'elfeed-search-mode) - (elfeed-search-update-entry entry)) - (message "Added video to watch later: %s" url)) - (message "The URL is not a YouTube link: %s" url))) - (message "No entry selected in Elfeed.")))) - -(provide 'bard-web) +*** Elfeed/EMMS YouTube code +:PROPERTIES: +:ID: 3ca0c5a0-4829-4411-a80b-f2fe69650ea0 +:END: +I made a video about this here: https://bardman.dev/technology/elfeed. + +#+begin_src emacs-lisp :tangle bard-elisp/bard-web.el :mkdirp yes + (defun bard/play-elfeed-video () + "Play the URL of the entry at point in mpv if it's a YouTube video." + (interactive) + (let ((entry (elfeed-search-selected :single))) + (if entry + (let ((url (elfeed-entry-link entry))) + (if (and url (string-match-p "https?://\\(www\\.\\)?youtube\\.com\\|youtu\\.be" url)) + (progn + (async-shell-command (format "mpv '%s'" url)) + (elfeed-search-untag-all-unread)) + (message "The URL is not a YouTube link: %s" url))) + (message "No entry selected in Elfeed.")))) + + (defun bard/add-video-emms-queue () + "Play the URL of the entry at point in mpv if it's a YouTube video. Add it to EMMS queue." + (interactive) + (let ((entry (elfeed-search-selected :single))) + (if entry + (let ((url (elfeed-entry-link entry))) + (if (and url (string-match-p "https?://\\(www\\.\\)?youtube\\.com\\|youtu\\.be" url)) + (let* ((playlist-name "Watch Later") + (playlist-buffer (get-buffer (format " *%s*" playlist-name)))) + (unless playlist-buffer + (setq playlist-buffer (emms-playlist-new (format " *%s*" playlist-name)))) + (emms-playlist-set-playlist-buffer playlist-buffer) + (emms-add-url url) + (elfeed-search-untag-all-unread) + (message "Added YouTube video to EMMS playlist: %s" url)) + (message "The URL is not a YouTube link: %s" url))) + (message "No entry selected in Elfeed.")))) + + (defun bard/add-video-watch-later () + "Add the current Elfeed YouTube entry URL to '~/Videos/watch-later.m3u' and mark it as read." + (interactive) + (let ((entry (elfeed-search-selected :single))) + (if entry + (let* ((url (elfeed-entry-link entry)) + (watch-later-file (expand-file-name "~/Videos/watch-later.m3u"))) + (if (and url (string-match-p "https?://\\(www\\.\\)?youtube\\.com\\|youtu\\.be" url)) + (progn + (with-temp-buffer + (insert (concat url "\n")) + (append-to-file (point-min) (point-max) watch-later-file)) + ;; Remove the 'unread tag from the entry directly + (setf (elfeed-entry-tags entry) + (remove 'unread (elfeed-entry-tags entry))) + ;; Force UI update + (when (derived-mode-p 'elfeed-search-mode) + (elfeed-search-update-entry entry)) + (message "Added video to watch later: %s" url)) + (message "The URL is not a YouTube link: %s" url))) + (message "No entry selected in Elfeed.")))) +#+end_src +*** Provide library +#+begin_src emacs-lisp :tangle bard-elisp/bard-web.el :mkdirp yes + (provide 'bard-web) #+end_src ** bard-window +This module has some code from [[https://protesilaos.com/dotemacs][Protesilaos's dotemacs]], especially the [[https://protesilaos.com/emacs/dotemacs#h:35b8a0a5-c447-4301-a404-bc274596238d][prot-window.el file]]. I copied most of this code a long time ago, so his library may have changed since then. But for me it works, and I never had to toy with it. No reason to reinvent the wheel with this one. + #+begin_src emacs-lisp :tangle bard-elisp/bard-window.el :mkdirp yes -(require 'prot-common) + (require 'prot-common) + + (defvar prot-window-window-sizes + '( :max-height (lambda () (floor (frame-height) 3)) + :min-height 10 + :max-width (lambda () (floor (frame-width) 4)) + :min-width 20) + "Property list of maximum and minimum window sizes. + The property keys are `:max-height', `:min-height', `:max-width', + and `:min-width'. They all accept a value of either a + number (integer or floating point) or a function.") + + (defun prot-window--get-window-size (key) + "Extract the value of KEY from `prot-window-window-sizes'." + (when-let ((value (plist-get prot-window-window-sizes key))) + (cond + ((functionp value) + (funcall value)) + ((numberp value) + value) + (t + (error "The value of `%s' is neither a number nor a function" key))))) + + (defun prot-window-select-fit-size (window) + "Select WINDOW and resize it. + The resize pertains to the maximum and minimum values for height + and width, per `prot-window-window-sizes'. + + Use this as the `body-function' in a `display-buffer-alist' entry." + (select-window window) + (fit-window-to-buffer + window + (prot-window--get-window-size :max-height) + (prot-window--get-window-size :min-height) + (prot-window--get-window-size :max-width) + (prot-window--get-window-size :min-width)) + ;; If we did not use `display-buffer-below-selected', then we must + ;; be in a lateral window, which has more space. Then we do not + ;; want to dedicate the window to this buffer, because we will be + ;; running out of space. + (when (or (window-in-direction 'above) (window-in-direction 'below)) + (set-window-dedicated-p window t))) + + (defun prot-window--get-display-buffer-below-or-pop () + "Return list of functions for `prot-window-display-buffer-below-or-pop'." + (list + #'display-buffer-reuse-mode-window + (if (or (prot-common-window-small-p) + (prot-common-three-or-more-windows-p)) + #'display-buffer-below-selected + #'display-buffer-pop-up-window))) + + (defun prot-window-display-buffer-below-or-pop (&rest args) + "Display buffer below current window or pop a new window. + The criterion for choosing to display the buffer below the + current one is a non-nil return value for + `prot-common-window-small-p'. + + Apply ARGS expected by the underlying `display-buffer' functions. + + This as the action function in a `display-buffer-alist' entry." + (let ((functions (prot-window--get-display-buffer-below-or-pop))) + (catch 'success + (dolist (fn functions) + (when (apply fn args) + (throw 'success fn)))))) + + ;; from protesilaos prot-shell library + (defun prot-window-shell-or-term-p (buffer &rest _) + "Check if BUFFER is a shell or terminal. + This is a predicate function for `buffer-match-p', intended for + use in `display-buffer-alist'." + (when (string-match-p "\\*.*\\(e?shell\\|v?term\\|terminal\\).*" (buffer-name (get-buffer buffer))) + (with-current-buffer buffer + ;; REVIEW 2022-07-14: Is this robust? + (and (not (derived-mode-p 'message-mode 'text-mode)) + (derived-mode-p 'eshell-mode 'shell-mode 'term-mode 'comint-mode 'fundamental-mode))))) +#+end_src -(defvar prot-window-window-sizes - '( :max-height (lambda () (floor (frame-height) 3)) - :min-height 10 - :max-width (lambda () (floor (frame-width) 4)) - :min-width 20) - "Property list of maximum and minimum window sizes. -The property keys are `:max-height', `:min-height', `:max-width', -and `:min-width'. They all accept a value of either a -number (integer or floating point) or a function.") - -(defun prot-window--get-window-size (key) - "Extract the value of KEY from `prot-window-window-sizes'." - (when-let ((value (plist-get prot-window-window-sizes key))) - (cond - ((functionp value) - (funcall value)) - ((numberp value) - value) - (t - (error "The value of `%s' is neither a number nor a function" key))))) - -(defun prot-window-select-fit-size (window) - "Select WINDOW and resize it. -The resize pertains to the maximum and minimum values for height -and width, per `prot-window-window-sizes'. - -Use this as the `body-function' in a `display-buffer-alist' entry." - (select-window window) - (fit-window-to-buffer - window - (prot-window--get-window-size :max-height) - (prot-window--get-window-size :min-height) - (prot-window--get-window-size :max-width) - (prot-window--get-window-size :min-width)) - ;; If we did not use `display-buffer-below-selected', then we must - ;; be in a lateral window, which has more space. Then we do not - ;; want to dedicate the window to this buffer, because we will be - ;; running out of space. - (when (or (window-in-direction 'above) (window-in-direction 'below)) - (set-window-dedicated-p window t))) - -(defun prot-window--get-display-buffer-below-or-pop () - "Return list of functions for `prot-window-display-buffer-below-or-pop'." - (list - #'display-buffer-reuse-mode-window - (if (or (prot-common-window-small-p) - (prot-common-three-or-more-windows-p)) - #'display-buffer-below-selected - #'display-buffer-pop-up-window))) - -(defun prot-window-display-buffer-below-or-pop (&rest args) - "Display buffer below current window or pop a new window. -The criterion for choosing to display the buffer below the -current one is a non-nil return value for -`prot-common-window-small-p'. - -Apply ARGS expected by the underlying `display-buffer' functions. - -This as the action function in a `display-buffer-alist' entry." - (let ((functions (prot-window--get-display-buffer-below-or-pop))) - (catch 'success - (dolist (fn functions) - (when (apply fn args) - (throw 'success fn)))))) - -;; from protesilaos prot-shell library -(defun prot-window-shell-or-term-p (buffer &rest _) - "Check if BUFFER is a shell or terminal. -This is a predicate function for `buffer-match-p', intended for -use in `display-buffer-alist'." - (when (string-match-p "\\*.*\\(e?shell\\|v?term\\|terminal\\).*" (buffer-name (get-buffer buffer))) - (with-current-buffer buffer - ;; REVIEW 2022-07-14: Is this robust? - (and (not (derived-mode-p 'message-mode 'text-mode)) - (derived-mode-p 'eshell-mode 'shell-mode 'term-mode 'comint-mode 'fundamental-mode))))) - -;; taken from https://github.com/hylophile/.files/blob/1f3f01e4e25b00f7b61eca286fcf4f865885090c/.config/doom/config.org#fancy-tab-bar - -(defun hy/tab-bar-format-align-center () - "Align the rest of tab bar items centered." - (let* ((rest (cdr (memq 'hy/tab-bar-format-align-center tab-bar-format))) - (rest (tab-bar-format-list rest)) - (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (progn - (add-face-text-property 0 (length rest) 'tab-bar t rest) - (string-pixel-width rest))) - (hpos (+ hpos (/ (- (frame-inner-width) hpos) 2))) - (str (propertize "​" 'display - ;; The `right' spec doesn't work on TTY frames - ;; when windows are split horizontally (bug#59620) - (if (window-system) - `(space :align-to (- right (,hpos))) - `(space :align-to (,(- (frame-inner-width) hpos))))))) - `((align-center menu-item ,str ignore)))) - -(setq tab-bar-tab-name-format-function #'hy/tab-bar-tab-name-format-default) -(defun hy/tab-bar-tab-name-format-default (tab i) - (let* ((hint (format "%d" i)) - (name (alist-get 'name tab)) - (dir (concat "(" (alist-get 'dir tab "") ")")) - (name-format (concat - " " - (propertize hint 'face 'tab-bar-hint) - " " - name - " "))) - (add-face-text-property - 0 (length name-format) - (funcall tab-bar-tab-face-function tab) - 'append name-format) - name-format)) - - -(setq tab-bar-tab-name-function #'hy/tab-bar-tab-name-current) -(defun hy/tab-bar-tab-name-current () - (hy/shorten-string - (hy/abbreviate-tab-name - (buffer-name (window-buffer (or (minibuffer-selected-window) - (and (window-minibuffer-p) - (get-mru-window)))))) - 25)) - -(defun hy/set-tab-dir () - (setf (alist-get 'dir (cdr (tab-bar--current-tab-find))) - (hy/tab-bar-dir))) - -(defun hy/abbreviate-directory-path (path) - "Turns `~/code/test/t` into `~/c/t/project`." - (let* ((directories (seq-filter (lambda (s) (not (string= s ""))) (split-string path "/"))) - (last-dir (car (last directories))) - (abbreviated-dirs (mapcar (lambda (dir) - (if (string= dir last-dir) - dir - (substring dir 0 (if (string-prefix-p "." dir) 2 1)))) - directories))) - (mapconcat 'identity abbreviated-dirs "/"))) - -(defun hy/tab-bar-dir () - (hy/shorten-string (hy/abbreviate-directory-path - (abbreviate-file-name - (or (projectile-project-root) default-directory))) - 10 - t)) - -(defun hy/shorten-string (string max-length &optional at-start) - (let ((len (length string))) - (if (> len max-length) - (if at-start - (concat "…" (substring string (- len max-length) len)) - (concat (substring string 0 max-length) "…")) - string))) - -(defun hy/abbreviate-tab-name (name) - (string-trim (replace-regexp-in-string - (rx (or "*" "helpful" "Org Src")) - "" name))) - -(defun bard/toggle-window-split () - "Toggle between horizontal and vertical window splits, preserving buffer layout." - (interactive) - (let ((current-buffers (mapcar #'window-buffer (window-list))) ; List of buffers in current windows - (split-direction (if (= (window-width) (frame-width)) - 'vertical - 'horizontal))) - (delete-other-windows) - ;; Toggle the split direction - (if (eq split-direction 'horizontal) - (split-window-vertically) - (split-window-horizontally)) - ;; Restore buffers to the new windows - (let ((windows (window-list))) - (cl-loop for buffer in current-buffers - for window in windows - do (set-window-buffer window buffer))))) +*** Tab bar +Code taken from [[https://github.com/hylophile/.files/blob/1f3f01e4e25b00f7b61eca286fcf4f865885090c/.config/doom/config.org#fancy-tab-bar][hylophile github]]. I do not use tabs very often, but when I do I like them to look a bit nicer than the default. -(provide 'bard-window) +This is what the tabs look like with ~doom-gruvbox~ theme: +[[file:img/tabs.png]] + + +#+begin_src emacs-lisp :tangle bard-elisp/bard-window.el :mkdirp yes + (defun hy/tab-bar-format-align-center () + "Align the rest of tab bar items centered." + (let* ((rest (cdr (memq 'hy/tab-bar-format-align-center tab-bar-format))) + (rest (tab-bar-format-list rest)) + (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) + (hpos (progn + (add-face-text-property 0 (length rest) 'tab-bar t rest) + (string-pixel-width rest))) + (hpos (+ hpos (/ (- (frame-inner-width) hpos) 2))) + (str (propertize "​" 'display + ;; The `right' spec doesn't work on TTY frames + ;; when windows are split horizontally (bug#59620) + (if (window-system) + `(space :align-to (- right (,hpos))) + `(space :align-to (,(- (frame-inner-width) hpos))))))) + `((align-center menu-item ,str ignore)))) + + (setq tab-bar-tab-name-format-function #'hy/tab-bar-tab-name-format-default) + (defun hy/tab-bar-tab-name-format-default (tab i) + (let* ((hint (format "%d" i)) + (name (alist-get 'name tab)) + (dir (concat "(" (alist-get 'dir tab "") ")")) + (name-format (concat + " " + (propertize hint 'face 'tab-bar-hint) + " " + name + " "))) + (add-face-text-property + 0 (length name-format) + (funcall tab-bar-tab-face-function tab) + 'append name-format) + name-format)) + + + (setq tab-bar-tab-name-function #'hy/tab-bar-tab-name-current) + (defun hy/tab-bar-tab-name-current () + (hy/shorten-string + (hy/abbreviate-tab-name + (buffer-name (window-buffer (or (minibuffer-selected-window) + (and (window-minibuffer-p) + (get-mru-window)))))) + 25)) + + (defun hy/set-tab-dir () + (setf (alist-get 'dir (cdr (tab-bar--current-tab-find))) + (hy/tab-bar-dir))) + + (defun hy/abbreviate-directory-path (path) + "Turns `~/code/test/t` into `~/c/t/project`." + (let* ((directories (seq-filter (lambda (s) (not (string= s ""))) (split-string path "/"))) + (last-dir (car (last directories))) + (abbreviated-dirs (mapcar (lambda (dir) + (if (string= dir last-dir) + dir + (substring dir 0 (if (string-prefix-p "." dir) 2 1)))) + directories))) + (mapconcat 'identity abbreviated-dirs "/"))) + + (defun hy/tab-bar-dir () + (hy/shorten-string (hy/abbreviate-directory-path + (abbreviate-file-name + (or (projectile-project-root) default-directory))) + 10 + t)) + + (defun hy/shorten-string (string max-length &optional at-start) + (let ((len (length string))) + (if (> len max-length) + (if at-start + (concat "…" (substring string (- len max-length) len)) + (concat (substring string 0 max-length) "…")) + string))) + + (defun hy/abbreviate-tab-name (name) + (string-trim (replace-regexp-in-string + (rx (or "*" "helpful" "Org Src")) + "" name))) +#+end_src + +*** Toggle window split direction +#+begin_src emacs-lisp :tangle bard-elisp/bard-window.el :mkdirp yes + (defun bard/toggle-window-split () + "Toggle between horizontal and vertical window splits, preserving buffer layout." + (interactive) + (let ((current-buffers (mapcar #'window-buffer (window-list))) ; List of buffers in current windows + (split-direction (if (= (window-width) (frame-width)) + 'vertical + 'horizontal))) + (delete-other-windows) + ;; Toggle the split direction + (if (eq split-direction 'horizontal) + (split-window-vertically) + (split-window-horizontally)) + ;; Restore buffers to the new windows + (let ((windows (window-list))) + (cl-loop for buffer in current-buffers + for window in windows + do (set-window-buffer window buffer))))) + + (provide 'bard-window) #+end_src ** bard-writing +*** Load required libraries #+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes -(require 'consult) -(require 'beframe) -(require 'calendar) -(require 'org-roam-node) -(require 'denote) - -(defvar bard/consult--source-notes - `(:name "Note Buffers" - :narrow ?n - :category buffer - :face consult-buffer - :history buffer-name-history - :items ,(lambda () - (mapcar #'buffer-name - (seq-filter - (lambda (buf) - (string-prefix-p "[Note]" (buffer-name buf))) - (beframe-buffer-list)))) - :action ,#'switch-to-buffer - :state ,#'consult--buffer-state) - "Consult source for note buffers (limited to beframe buffers).") - - -(defun bard/find-notes-file () - (interactive) - (consult-find "~/Notes/denote")) - -(defun bard/search-notes-directory () - (interactive) - (consult-grep "~/Notes/denote")) - -(defun bard/consult-buffer-notes () - "Show `consult-buffer` limited to buffers starting with [Note]." - (interactive) - (consult-buffer '(bard/consult--source-notes))) + (require 'consult) + (require 'beframe) + (require 'calendar) + (require 'org-roam-node) + (require 'denote) +#+end_src -(defun bard/ibuffer-notes () - "Open `ibuffer` limited to buffers starting with [Note]." - (interactive) - (ibuffer nil "*Ibuffer-Notes*" - '((name . "^\\[Note\\]")))) +*** Note buffers +#+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes + (defvar bard/consult--source-notes + `(:name "Note Buffers" + :narrow ?n + :category buffer + :face consult-buffer + :history buffer-name-history + :items ,(lambda () + (mapcar #'buffer-name + (seq-filter + (lambda (buf) + (string-prefix-p "[Note]" (buffer-name buf))) + (beframe-buffer-list)))) + :action ,#'switch-to-buffer + :state ,#'consult--buffer-state) + "Consult source for note buffers (limited to beframe buffers).") + + (defun bard/consult-buffer-notes () + "Show `consult-buffer` limited to buffers starting with [Note]." + (interactive) + (consult-buffer '(bard/consult--source-notes))) -(defun denote-sequence-region () - "Call `denote-sequence' and insert therein the text of the active region. + (defun bard/ibuffer-notes () + "Open `ibuffer` limited to buffers starting with [Note]." + (interactive) + (ibuffer nil "*Ibuffer-Notes*" + '((name . "^\\[Note\\]")))) +#+end_src -Note that, currently, `denote-save-buffers' and -`denote-kill-buffers' are NOT respected. The buffer is not -saved or killed at the end of `denote-sequence-region'." - (declare (interactive-only t)) - (interactive) - (if-let* (((region-active-p)) - ;; We capture the text early, otherwise it will be empty - ;; the moment `insert' is called. - (text (buffer-substring-no-properties (region-beginning) (region-end)))) - (progn - (let ((denote-ignore-region-in-denote-command t) - ;; FIXME: Find a way to insert the region before the buffer is - ;; saved/killed by the creation command. - (denote-save-buffers nil) - (denote-kill-buffers nil)) - (call-interactively 'denote-sequence)) - (push-mark (point)) - (insert text) - (run-hook-with-args 'denote-region-after-new-note-functions (mark) (point))) - (call-interactively 'denote-sequence))) - -(defvar bard/class-dirs - '(("ANTH 204" . "~/Documents/dox/Uni/FALL2025-ANTH 204/") - ("CHEM 201" . "~/Documents/dox/Uni/FALL2025-CHEM 201/") - ("CHEM 207" . "~/Documents/dox/Uni/FALL2025-CHEM 207/") - ("ENGL 105" . "~/Documents/dox/Uni/FALL2025-ENGL 105/") - ("ENGR 101" . "~/Documents/dox/Uni/FALL2025-ENGR 101/") - ("ENGR 110" . "~/Documents/dox/Uni/FALL2025-ENGR 110/")) - "Mapping of class names to their document directories.") - -(defvar bard/uni-notes-file "~/Notes/denote/uni.org" - "Path to the main university org file.") - -(defun bard/jump-to-class (class) - "Jump to CLASS heading in `bard/uni-notes-file` and open its dir in dired." - (interactive - (list (completing-read "Class: " (mapcar #'car bard/class-dirs)))) - (let* ((dir (cdr (assoc class bard/class-dirs)))) - ;; split windows - (delete-other-windows) - (let ((notes-window (selected-window)) - (dired-window (split-window-right))) - ;; open notes file and jump to heading - (with-selected-window notes-window - (find-file bard/uni-notes-file) - (widen) - (goto-char (point-min)) - (message class) - (search-forward class nil nil)) - ;; open dired in right window - (with-selected-window dired-window - (dired dir))))) - -;; (defun bard/jump-to-class-new-frame (class) -;; "Open CLASS notes and dir in a new frame titled after CLASS." -;; (interactive -;; (list (completing-read "Class: " (mapcar #'car bard/class-dirs)))) -;; (let* ((dir (cdr (assoc class bard/class-dirs))) -;; ;; make a new frame with title -;; (frame (make-frame `((name . ,class))))) -;; (select-frame-set-input-focus frame) -;; (delete-other-windows) -;; (let ((notes-window (selected-window)) -;; (dired-window (split-window-right))) -;; ;; open notes file and jump to heading -;; (with-selected-window notes-window -;; (find-file bard/uni-notes-file) -;; (widen) -;; (goto-char (point-min)) -;; (search-forward class nil nil)) -;; ;; open dired in right window -;; (with-selected-window dired-window -;; (dired dir))))) - -(defun bard/jump-to-class-new-frame (class) - "Open CLASS notes and dir in a new frame titled after CLASS, even with beframe." - (interactive - (list (completing-read "Class: " (mapcar #'car bard/class-dirs)))) - (let* ((dir (cdr (assoc class bard/class-dirs))) - (frame (make-frame `((frame-title-format . ,class))))) - (select-frame-set-input-focus frame) - (delete-other-windows) - (let ((notes-window (selected-window)) - (dired-window (split-window-right))) - (with-selected-window notes-window - (find-file bard/uni-notes-file) - (widen) - (goto-char (point-min)) - (search-forward class nil nil)) - (with-selected-window dired-window - (dired dir) - (beframe-rename-current-frame))))) - -;; Optional: bind to a key -(global-set-key (kbd "C-c u") #'bard/jump-to-class) -(global-set-key (kbd "C-c U") #'bard/jump-to-class-new-frame) - -(defun bard/denote-todo-template () - "Return string for daily tasks heading in `denote-journal' entries" - (format "* Tasks for %s\n\n* Notes for today" - (format-time-string "%Y-%m-%d (%a)"))) - -;; Taken from: https://stackoverflow.com/a/75314192 -(defun add-multiple-into-list (lst items) - "Add each item from ITEMS into LST." - (dolist (item items) - (add-to-list lst item))) +*** Searching notes +#+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes + (defun bard/find-notes-file () + (interactive) + (consult-find "~/Notes/denote")) -(defun bard/cdlatex-add-math-symbols () - "Add functions into list." - (add-multiple-into-list - 'cdlatex-math-symbol-alist-comb - '((?V "\\vec")))) + (defun bard/search-notes-directory () + (interactive) + (consult-grep "~/Notes/denote")) +#+end_src -(define-minor-mode bard/org-math-mode - "Enable features to write math in `org-mode'." - :init-value nil - :lighter " S=" - :global nil - (org-fragtog-mode t) - (org-cdlatex-mode t) - (electric-pair-local-mode t) - (bard/cdlatex-add-math-symbols)) +*** Denote +#+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes + (defvar bard/class-dirs + '(("ANTH 204" . "~/Documents/Uni/FALL2025-ANTH 204/") + ("CHEM 201" . "~/Documents/Uni/FALL2025-CHEM 201/") + ("CHEM 207" . "~/Documents/Uni/FALL2025-CHEM 207/") + ("ENGL 105" . "~/Documents/Uni/FALL2025-ENGL 105/") + ("ENGR 101" . "~/Documents/Uni/FALL2025-ENGR 101/") + ("ENGR 110" . "~/Documents/Uni/FALL2025-ENGR 110/")) + "Mapping of class names to their document directories.") + + (defvar bard/uni-notes-file "~/Notes/denote/uni.org" + "Path to the main university org file.") + + (defun bard/jump-to-class (class) + "Jump to CLASS heading in `bard/uni-notes-file` and open its dir in dired." + (interactive + (list (completing-read "Class: " (mapcar #'car bard/class-dirs)))) + (let* ((dir (cdr (assoc class bard/class-dirs)))) + ;; split windows + (delete-other-windows) + (let ((notes-window (selected-window)) + (dired-window (split-window-right))) + ;; open notes file and jump to heading + (with-selected-window notes-window + (find-file bard/uni-notes-file) + (widen) + (goto-char (point-min)) + (message class) + (search-forward class nil nil)) + ;; open dired in right window + (with-selected-window dired-window + (dired dir))))) + + (defun bard/jump-to-class-new-frame (class) + "Open CLASS notes and dir in a new frame titled after CLASS, even with beframe." + (interactive + (list (completing-read "Class: " (mapcar #'car bard/class-dirs)))) + (let* ((dir (cdr (assoc class bard/class-dirs))) + (frame (make-frame `((frame-title-format . ,class))))) + (select-frame-set-input-focus frame) + (delete-other-windows) + (let ((notes-window (selected-window)) + (dired-window (split-window-right))) + (with-selected-window notes-window + (find-file bard/uni-notes-file) + (widen) + (goto-char (point-min)) + (search-forward class nil nil)) + (with-selected-window dired-window + (dired dir) + (beframe-rename-current-frame))))) + + ;; Optional: bind to a key + (global-set-key (kbd "C-c u") #'bard/jump-to-class) + (global-set-key (kbd "C-c U") #'bard/jump-to-class-new-frame) +#+end_src +*** Denote journal template +#+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes + (defun bard/denote-todo-template () + "Return string for daily tasks heading in `denote-journal' entries." + (with-temp-buffer + (org-mode) + (insert (format "* Tasks for %s\n** Время я потратил бездельничая\n\n* Notes for today\n\n" + (format-time-string "%Y-%m-%d (%a)"))) + (let ((org-clock-clocktable-default-properties + '(:scope file :maxlevel 3 :link nil :compact t))) + (org-clock-report)) + (buffer-string))) +#+end_src -(provide 'bard-writing) +*** Math input mode +#+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes + ;; Taken from: https://stackoverflow.com/a/75314192 + (defun add-multiple-into-list (lst items) + "Add each item from ITEMS into LST." + (dolist (item items) + (add-to-list lst item))) + + (defun bard/cdlatex-add-math-symbols () + "Add functions into list." + (add-multiple-into-list + 'cdlatex-math-symbol-alist-comb + '((?V "\\vec")))) + + (define-minor-mode bard/org-math-mode + "Enable features to write math in `org-mode'." + :init-value nil + :lighter " S=" + :global nil + (org-fragtog-mode t) + (org-cdlatex-mode t) + (electric-pair-local-mode t) + (bard/cdlatex-add-math-symbols)) +#+end_src +*** Provide library +#+begin_src emacs-lisp :tangle bard-elisp/bard-writing.el :mkdirp yes + (provide 'bard-writing) #+end_src ** prot-common +This library is mostly used in the ~bard-modeline.el~ library. It is mostly unmodified from the time when I copied it from [[https://protesilaos.com/dotemacs][Protesilaos's Emacs configuration]] over 2 years ago. + #+begin_src emacs-lisp :tangle bard-elisp/prot-common.el :mkdirp yes ;;; prot-common.el --- Common functions for my dotemacs -*- lexical-binding: t -*- -- cgit v1.2.3