From af3eb37c8e51084261f2ad4bfe1d36fffbcfaebf Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 8 Jun 2022 17:59:53 -0500 Subject: blep --- early-init.el | 7 +- init.el | 212 ++++++++++++++++--------------- lisp/+apheleia.el | 51 +++++++- lisp/+avy.el | 40 ++++-- lisp/+circe.el | 52 ++++---- lisp/+cus-edit.el | 2 +- lisp/+emacs.el | 17 ++- lisp/+flyspell-correct.el | 3 + lisp/+modeline.el | 22 ++-- lisp/+nyan-mode.el | 39 ++++++ lisp/+org-wc.el | 2 +- lisp/+org.el | 53 +++++++- lisp/+tab-bar.el | 314 +++++++++++++++++++++++----------------------- lisp/+window.el | 130 +++++++++++++++++++ lisp/private.el | 4 + 15 files changed, 634 insertions(+), 314 deletions(-) create mode 100644 lisp/+nyan-mode.el create mode 100644 lisp/+window.el diff --git a/early-init.el b/early-init.el index 12e2b0d..5109795 100644 --- a/early-init.el +++ b/early-init.el @@ -44,7 +44,12 @@ restore that." (set-default variable value))) ;; Garbage collection -(+set-during-startup 'gc-cons-threshold most-positive-fixnum (* 128 1024 1024)) +(+set-during-startup 'gc-cons-threshold most-positive-fixnum) + +(add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter () + (setq gc-cons-threshold most-positive-fixnum))) +(add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit () + (setq gc-cons-threshold 800000))) ;; Don't prematurely re-display (unless debug-on-error diff --git a/init.el b/init.el index 2932768..f7fbe96 100644 --- a/init.el +++ b/init.el @@ -45,7 +45,6 @@ "C-x 4 n" #'clone-buffer "C-c v" #'visible-mode "C-M-;" #'+lisp-comment-or-uncomment-sexp - "M-j" nil "C-x C-o" #'+switch-to-last-buffer "C-x o" #'+switch-to-last-buffer "C-x C-l" #'+open-paragraph ; original: downcase-region @@ -53,7 +52,13 @@ "C-x C-m" #'execute-extended-command ; original: coding systems "C-" #'+backward-kill-word "C-x TAB" #'+indent-rigidly + "" #'flyspell-mode "C-x C-c" #'+save-buffers-quit) + ;; Disable bindings + (:global "M-j" nil + "" nil) + (:+leader "C-t d" #'toggle-debug-on-error + "C-t q" #'toggle-debug-on-quit) ;; C-h deletes backward - see https://idiomdrottning.org/bad-emacs-defaults (global-set-key (kbd "C-h") 'delete-backward-char) (keyboard-translate ?\C-h ?\C-?) @@ -81,6 +86,8 @@ (+with-ensure-after-init (:hook #'+init-add-setup-to-imenu))) +(setup (:require +window)) + (setup (:require auth-source) (:option auth-sources (list 'default "secrets:passwords" @@ -106,6 +113,9 @@ (dolist (var '(safe-local-variable-values warning-suppress-types)) (add-to-list '+custom-variable-allowlist var)) + ;; Load customizations now, and after init (to capture other possible + ;; variables I want to load) XXX: this is dumb + (+custom-load-ignoring-most-customizations) (+with-ensure-after-init (+custom-load-ignoring-most-customizations)) (advice-add #'custom-buffer-create-internal :after #'+cus-edit-expand-widgets) @@ -165,15 +175,19 @@ auto-revert-verbose nil) (global-auto-revert-mode +1)) +(setup awk-mode + (:apheleia gawk '("gawk" "-f-" "-o-"))) + (setup bookmark (:option bookmark-save-flag 1 - bookmark-watch-bookmark-file 'silent)) + bookmark-watch-bookmark-file 'silent + bookmark-set-fringe-mark nil)) (setup browse-url (:require +browse-url) (:option - browse-url-browser-function #'eww-browse-url - +browse-url-browser-function browse-url-browser-function + browse-url-browser-function 'browse-url-default-browser + +browse-url-browser-function #'eww-browse-url browse-url-generic-program (seq-some #'executable-find '("firefox" "chromium" @@ -214,6 +228,7 @@ ;; Set up URL handlers. (:option browse-url-handlers (list + (cons (rx bos (or "gemini:" "gopher:")) #'elpher-browse-url-elpher) (cons (rx ; images "." (or "jpeg" "jpg" "png" "bmp") eos) (lambda (&rest args) @@ -328,7 +343,8 @@ (setup eshell (:also-load em-smart em-tramp) - (:require +eshell) + (:require +eshell + esh-module) (+define-dir eshell/ (locate-user-emacs-file "eshell") "Where to place Eshell-specific files.") (:option eshell-aliases-file (eshell/ "aliases") @@ -353,9 +369,11 @@ (* " "))) (:+leader "s" #'+eshell-here "C-s" #'+eshell-here) + (add-to-list 'eshell-modules-list 'eshell-tramp) (with-eval-after-load 'mwim (setf (alist-get 'eshell-mode mwim-beginning-of-line-function) #'eshell-bol)) + (:hook #'eshell-smart-initialize) (+eshell-eval-after-load ;; Local modes (dolist (mode '((hungry-delete-mode . -1))) @@ -381,7 +399,10 @@ (setup eww (:also-load +eww) (:option eww-search-prefix "https://duckduckgo.com/html?q=" - url-privacy-level '(email agent cookies lastloc)) + url-privacy-level '(email agent cookies lastloc) + eww-use-browse-url (rx bos (or "mailto:" + "gemini:" + "gopher:"))) (add-hook 'eww-after-render-hook #'reading-mode) (:hook #'+eww-bookmark-setup #'+eww-track-readable-mode) @@ -390,9 +411,6 @@ "M-n" nil "M-p" nil)) -(setup flyspell - (:hook-into org-mode)) - (setup hideshow (:also-load +hideshow) (:with-mode hs-minor-mode @@ -422,9 +440,12 @@ ("help" (or (mode . help-mode) (mode . Info-mode) (mode . helpful-mode))) - ("irc" (or (mode . erc-mode) - (mode . circe-server-mode) - (mode . circe-channel-mode))) + ("chat" (or (mode . erc-mode) + (mode . circe-server-mode) + (mode . circe-channel-mode) + (mode . jabber-chat-mode) + (mode . jabber-browse-mode) + (mode . jabber-roster-mode))) ("shell" (or (mode . eshell-mode) (mode . shell-mode) (mode . vterm-mode))) @@ -531,17 +552,25 @@ (add-hook 'message-send-hook #'+send-mail-dispatch) (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) (:option notmuch-saved-searches (list - (list :name "inbox" + (list :name "inbox+unread" :query (+notmuch-query-concat "tag:inbox" "tag:unread" "NOT tag:Spam") :key "i") - (list :name "lists" + (list :name "inbox" + :query (+notmuch-query-concat + "tag:inbox" + "NOT tag:Spam") + :key "I") + (list :name "lists+unread" :query (+notmuch-query-concat "tag:/List/" "tag:unread") :key "l") + (list :name "lists" + :query "tag:/List/" + :key "L") (list :name "unread" :query (+notmuch-query-concat "tag:unread" @@ -630,7 +659,7 @@ org-src-window-setup 'current-window org-startup-truncated nil org-startup-with-inline-images t - org-tags-column (- (- fill-column (length org-ellipsis))) + org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis))) org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" "|" "DONE(d!)") (sequence "|" "CANCELED(k@)") @@ -656,6 +685,7 @@ ;; )))) (:bind "RET" #'+org-return-dwim "" #'+org-table-copy-down + "M-RET" #'+org-meta-return "C-c C-l" #'+org-insert-link-dwim "C-c C-n" #'+org-next-heading-widen "C-c C-p" #'+org-previous-heading-widen @@ -675,11 +705,11 @@ "C-c l" #'org-store-link) (+with-ensure-after-init (:hook #'variable-pitch-mode - #'visual-fill-column-mode - #'turn-off-auto-fill - #'org-indent-mode - #'prettify-symbols-mode - #'+org-wrap-on-hyphens)) + #'visual-fill-column-mode + #'turn-off-auto-fill + #'org-indent-mode ;; Needed for proper hanging indents in lists + #'prettify-symbols-mode + #'+org-wrap-on-hyphens)) (:local-set prettify-symbols-alist '(("DEADLINE:" . ?→) ("SCHEDULED:" . ?↷) ("CLOSED:" . ?✓)) @@ -716,11 +746,13 @@ ;; complains about "Invalid face reference: t" in org-mode buffers, because ;; `compose-region' returns t. ("^[ \t]*\\([-]\\) " - (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "–") 'fixed-pitch) - 'fixed-pitch t)) + (0 (progn (compose-region (match-beginning 1) (match-end 1) "–") 'fixed-pitch) + ;; 'fixed-pitch t + )) ("^[ \t]*\\([+]\\) " - (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "¬") 'fixed-pitch) - 'fixed-pitch t)) + (0 (progn (compose-region (match-beginning 1) (match-end 1) "•") 'fixed-pitch) + ;; 'fixed-pitch t + )) ("^[ \t]+\\([*]\\) " (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "→") 'fixed-pitch) 'fixed-pitch t)) @@ -841,10 +873,7 @@ org-export-with-sub-superscripts t org-export-with-toc nil) (with-eval-after-load 'ox - (+org-export-pre-hooks-insinuate)) - (add-hook '+org-export-pre-hook #'+flyspell-correct-buffer) - (with-eval-after-load 'user-save - (add-hook '+org-export-pre-hook #'user-save-run-hooks))) + (+org-export-pre-hooks-insinuate))) (setup password-cache (:option password-cache t @@ -869,6 +898,9 @@ (+scratch-text-scratch)) (add-hook 'kill-buffer-query-functions #'+scratch-immortal)) +(setup sh + (:apheleia shfmt '("shfmt"))) + (setup shell (:option shell-command-prompt-show-cwd t) (:local-set +modeline-position-function @@ -920,6 +952,9 @@ (tab-bar-mode +1) (display-time-mode +1)) +(setup text-mode + (:bind "C-M-k" #'kill-paragraph)) + (setup timer-list (:bind "d" #'timer-list-cancel) (:hook #'hl-line-mode @@ -995,6 +1030,10 @@ [remap isearch-query-replace] #'anzu-isearch-query-replace [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace-regexp)) +(setup (:straight apheleia) + (:require apheleia +apheleia) + (apheleia-global-mode +1)) + (setup (:straight avy) (:require avy +avy) (:option avy-background t @@ -1208,7 +1247,7 @@ (:with-mode circe-chat-mode (:local-set lui-input-function #'+lui-filter - +modeline-position-function 'empty) + +modeline-position-function #'ignore) (:hook #'enable-circe-color-nicks #'enable-circe-new-day-notifier #'+circe-chat@set-prompt @@ -1223,6 +1262,7 @@ (:with-mode lui-mode (:option lui-fill-column (+ fill-column +circe-left-margin) lui-fill-type nil + lui-max-buffer-size (+bytes 10 :kb) lui-time-stamp-position 'right-margin lui-time-stamp-format "| %H:%M" lui-track-behavior 'before-switch-to-buffer @@ -1251,6 +1291,7 @@ #'enable-lui-track #'visual-fill-column-mode #'enable-lui-autopaste + (defun turn-off-+nyan-mode () (+nyan-local-mode -1)) (defun turn-off-electric-pair-mode () (electric-pair-mode -1))) (:local-set fringes-outside-margins t right-margin-width (length lui-time-stamp-format) @@ -1303,8 +1344,10 @@ xref-show-xrefs-function #'consult-xref xref-show-definitions-function #'consult-xref tab-always-indent 'complete - ;; completion-in-region-function #'consult-completion-in-region + completion-in-region-function #'consult-completion-in-region ) + (:with-mode minibuffer-mode + (:local-set completion-in-region-function #'consult-completion-in-region)) (advice-add #'register-preview :override #'consult-register-window) (dolist (binding '(;; C-c bindings (mode-specific-map) ("C-c h" . consult-history) @@ -1382,19 +1425,6 @@ (with-eval-after-load 'orderless (:option consult--regexp-compiler #'consult--orderless-regexp-compiler)))) -(setup (:straight corfu) - (global-corfu-mode +1)) - -(setup (:straight crossword) - ;; This isn't the perfect Emacs crossword puzzle, but it's the only one I - ;; know. - (:hook #'turn-off-+key-mode) - (:option crossword-save-path (sync/ "emacs/crosswords/" t) - crossword-empty-position-char "=") - (:face 'crossword-grid-face '((t :inherit 'font-lock-string-face)) - 'crossword-current-face '((t :inherit 'highlight)) - 'crossword-other-dir-face '((t :inherit 'font-lock-keyword-face)))) - (setup (:straight crux) ;; yes it's silly I have an addon to this addon. (:require crux +crux) @@ -1472,6 +1502,11 @@ (+with-ensure-after-init (edit-server-start))) +(setup (:straight editorconfig) + (:with-mode conf-mode + (:file-match (rx ".editorconfig" eos))) + (editorconfig-mode +1)) + (setup (:straight electric-cursor) (:option electric-cursor-alist '((overwrite-mode . hbar) (god-local-mode . box) @@ -1489,7 +1524,7 @@ "~/Downloads/") if (file-exists-p dir) return dir) - elfeed-search-filter "@1-month-ago +unread" + elfeed-search-filter "@10-days-ago +unread" elfeed-search-trailing-width 24 elfeed-search-title-min-width 24 elfeed-search-title-max-width 78 @@ -1685,10 +1720,6 @@ (:option frowny-eyes (rx (any ":=") (opt "'") (? "-"))) (global-frowny-mode +1)) -(setup (:straight gcmh) - (:option gcmh-idle-delay 'auto) - (gcmh-mode +1)) - (setup (:straight (geiser :type git :flavor melpa @@ -1701,8 +1732,8 @@ scheme-complete)) (straight-use-package pkg)) (:require +chicken) - (setf (alist-get "\\.scm\\'" auto-mode-alist nil nil #'string=) - 'scheme-mode) + (:with-mode scheme-mode + (:file-match (rx ".scm" eos))) (setf (alist-get "\\.scm\\'" auto-insert-alist nil nil #'equal) '(insert "#!/bin/sh\n#| -*- scheme -*-\nexec csi -s $0 \"$@\"\n|#\n"))) @@ -1855,7 +1886,8 @@ ((string-match-p "hmm@" (buffer-name)) "🤔 "))) file-percentage-mode nil - wrap-prefix (make-string +jabber-ws-prefix ?\ ))) + wrap-prefix (make-string +jabber-ws-prefix ?\ ) + comment-start nil)) (:+leader "C-j" jabber-global-keymap) (advice-add 'jabber-activity-add :after #'+jabber-tracking-add) (advice-add 'jabber-activity-add-muc :after #'+jabber-tracking-add-muc) @@ -1921,7 +1953,7 @@ (setup (:straight (magit :host github :repo "magit/magit" :build (:not compile)) (:straight (transient :host github :repo "magit/transient" - :build (:not compile)))) + :build (:not compile)))) (autoload 'transient--with-suspended-override "transient")) (setup (:straight marginalia) @@ -1929,9 +1961,7 @@ (setup (:straight markdown-mode) (:option markdown-hide-markup nil) - (add-to-list 'auto-mode-alist (cons (rx (or ".md" ".markdown" ".mdown") - eos) - 'markdown-mode)) + (:file-match (rx (or ".md" ".markdown" ".mdown") eos)) (with-eval-after-load 'visual-fill-column (:hook #'visual-fill-column-mode)) (with-eval-after-load 'apheleia @@ -1940,7 +1970,8 @@ (setf (alist-get 'markdown-mode apheleia-mode-alist) 'markdownfmt) (setf (alist-get 'gfm-mode apheleia-mode-alist) 'markdownfmt)))) -(setup (:straight mastodon) +(setup (:straight (mastodon + :fork (:host nil :repo "https://codeberg.org/acdw/mastodon.el"))) (:option mastodon-instance-url "https://tiny.tilde.website" mastodon-active-user "acdw" mastodon-client--token-file (.etc "mastodon.plstore") @@ -1957,15 +1988,6 @@ #'hl-line-mode #'lin-mode)) -(setup (:straight md4rd - :quit) - ;; `md4rd' is ... a bit janky, tbh. But I'm including this here so I have it. - ;; TODO: enable opening Reddit links in md4rd - (:also-load _md4rd) - (defalias 'reddit 'md4rd "Browse Reddit.") - (with-eval-after-load 'md4rd - (run-with-timer 0 (* 60 59) 'md4rd-refresh-login))) - (setup (:straight minions) (minions-mode +1)) @@ -2096,12 +2118,17 @@ (:hook #'visual-fill-column-mode) (:file-match (rx ".epub" eos))) -(setup (:straight nyan-mode) - (:require) - ;; For some reason, in some modes the mode-line isn't updated after these - ;; commands. I think it might have to do with `+modeline-position-function'. - (advice-add 'end-of-buffer :after #'force-mode-line-update) - (advice-add 'beginning-of-buffer :after #'force-mode-line-update)) +(setup (:straight (nyan-mode + :fork (:repo "duckwork/nyan-mode"))) + (:require nyan-mode +nyan-mode) + (with-eval-after-load 'modus-themes + (add-hook 'modus-themes-after-load-theme-hook + (defun +nyan-modus-update-colors () + (modus-themes-with-colors + (set-face-attribute '+nyan-mode-line nil + :background bg-special-warm)))) + (+nyan-modus-update-colors)) + (+nyan-mode +1)) (setup (:straight ol-notmuch)) @@ -2149,19 +2176,6 @@ (defun org-mime-setup@org-mode () (local-set-key (kbd "C-c M-o") 'org-mime-org-buffer-htmlize)))) -(setup (:straight org-modern) - (:quit "I think I can do most of this myself.") - (:option org-modern-hide-stars nil - org-modern-star nil - org-modern-list nil - org-modern-progress ["..." "o.." "oo." "Oo." "Ooo" "OOo" "OOO"]) - (:face 'org-modern-label '((t ( :height 1.0 - :weight regular - :underline nil - :inherit fixed-pitch)))) - (advice-add 'org-modern--update-label-face :override #'ignore) - (:hook-into org-mode)) - (setup (:straight (org-taskwise :host github :repo "duckwork/org-taskwise.el")) @@ -2235,9 +2249,8 @@ (executable-find "g++"))) (:also-load +pdf-tools) (:with-mode pdf-view-mode - (:local-set +modeline-position-function #'+pdf-view-position)) - (setf (alist-get "\\.pdf\\'" auto-mode-alist nil nil #'equal) - #'pdf-view-mode) + (:local-set +modeline-position-function #'+pdf-view-position) + (:file-match (rx ".pdf" eos))) (pdf-tools-install :no-query)) (setup (:straight persistent-scratch) @@ -2304,8 +2317,8 @@ +modeline-buffer-name +modeline-major-mode (lambda () (+modeline-vc " : ")) - +modeline-anzu +modeline-nyan-on-focused + +modeline-anzu ) ( ; right simple-modeline-segment-process @@ -2369,7 +2382,9 @@ #'describe-gnu-project #'suspend-frame) (sophomore-disable-with 'confirm - #'save-buffers-kill-terminal) + #'save-buffers-kill-terminal) + (sophomore-disable-with 'confirm-y + #'+save-buffers-quit) (sophomore-mode +1)) (setup (:straight (spongebob-case @@ -2445,9 +2460,10 @@ (setup (:straight (twtxt :fork (:repo "duckwork/twtxt-el"))) - (:option twtxt-file "/sshx:hetzner:/var/www/acdw.casa/tw.txt" - twtxt-following '(("acdw" "https://acdw.casa/tw.txt"))) - (+with-ensure-after-init (:require))) + (:require) + (:also-load _twtxt) + (:option twtxt-file _twtxt-file + twtxt-following _twtxt-following)) (setup (:straight undo-fu) (:option undo-fu-allow-undo-in-region t) @@ -2473,8 +2489,6 @@ 'undo-hl-insert '((t :underline t))) (:hook-into text-mode prog-mode)) -(setup (:straight unfill)) - (setup (:straight valign :quit "Doesn't work with narrowed tables.") (:option valign-fancy-bar t) @@ -2535,12 +2549,10 @@ :repo "casouri/vundo"))) (setup (:straight web-mode) - (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php" - "asp" "gsp" "jsp" "ascx" "aspx" - "erb" "mustache" "djhtml") - eos) - auto-mode-alist) - 'web-mode) + (:file-match (rx "." (or "htm" "html" "phtml" "tpl.php" + "asp" "gsp" "jsp" "ascx" "aspx" + "erb" "mustache" "djhtml") + eos)) (with-eval-after-load 'apheleia (setf (alist-get 'web-mode apheleia-mode-alist) 'prettier))) diff --git a/lisp/+apheleia.el b/lisp/+apheleia.el index 469232a..df651b8 100644 --- a/lisp/+apheleia.el +++ b/lisp/+apheleia.el @@ -2,14 +2,61 @@ ;;; Code: +(require 'apheleia) +(require 'cl-lib) + ;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623 -(defun +apheleia-indent-region (orig scratch callback _error) +(cl-defun +apheleia-indent-region (&key buffer scratch formatter callback &allow-other-keys) (with-current-buffer scratch (setq-local indent-line-function - (buffer-local-value 'indent-line-function orig)) + (buffer-local-value 'indent-line-function buffer)) (indent-region (point-min) (point-max)) (funcall callback))) + +;;; `setup' integration + +(require 'setup) + +(setup-define :apheleia + (lambda (name formatter &optional mode -pend) + (let* ((mode (or mode (setup-get 'mode))) + (current-formatters (and -pend + (alist-get mode apheleia-formatters)))) + `(progn + (setf (alist-get ',name apheleia-formatters) + ,formatter) + (setf (alist-get ',mode apheleia-mode-alist) + ',(pcase -pend + (:append (append (ensure-list current-formatters) + (list name))) + (:prepend (cons name (ensure-list current-formatters))) + ('nil name) + (_ (error "Improper `:apheleia' -PEND argument"))))))) + :documentation + "Register a formatter to `apheleia''s lists. +NAME is the name given to the formatter in `apheleia-formatters' +and `apheleia-mode-alist'. FORMATTER is the command paired with +NAME in `apheleia-formatters'. MODE is the mode or modes to add +NAME to in `apheleia-mode-alist'. If MODE is not given or nil, +use the setup form's MODE. Optional argument -PEND can be one of +`:append' or `:prepend', and if given will append or prepend the +given NAME to the current formatters for the MODE in +`apheleia-mode-alist', rather than replace them (the default). + +Example: +(setup + (:apheleia isort (\"isort\" \"--stdout\" \"-\") + python-mode)) +; => +(progn + (setf (alist-get 'isort apheleia-formatters) + '(\"isort\" \"--stdout\" \"-\")) + (setf (alist-get 'python-mode apheleia-mode-alist) + 'isort)) + +This form cannot be repeated, and it cannot be used as HEAD.") + (provide '+apheleia) ;;; +apheleia.el ends here diff --git a/lisp/+avy.el b/lisp/+avy.el index 8056f00..b0837a3 100644 --- a/lisp/+avy.el +++ b/lisp/+avy.el @@ -50,17 +50,35 @@ (defvar-local +avy-buffer-face-mode-face nil "The state of `buffer-face-mode' before calling `avy-with'.") -(defun +avy@un-buffer-face (&rest _) +;;; XXX: Doesn't switch back if avy errors out or quits +(defun +avy@un-buffer-face (win) "BEFORE advice on `avy-with' to disable `buffer-face-mode'." - (when buffer-face-mode - (setq +avy-buffer-face-mode-face buffer-face-mode-face) - (buffer-face-mode -1))) + (with-current-buffer (window-buffer win) + (when buffer-face-mode + (setq +avy-buffer-face-mode-face buffer-face-mode-face) + (buffer-face-mode -1)))) -(defun +avy@re-buffer-face (&rest _) +(defun +avy@re-buffer-face (win) "AFTER advice on `avy-with' to re-enable `buffer-face-mode'." - (when +avy-buffer-face-mode-face - (setq buffer-face-mode-face +avy-buffer-face-mode-face) - (buffer-face-mode +1))) + (with-current-buffer (window-buffer win) + (when +avy-buffer-face-mode-face + (setq buffer-face-mode-face +avy-buffer-face-mode-face) + (buffer-face-mode +1))) + (let ((bounds (bounds-of-thing-at-point 'symbol))) + (when (and (car bounds) + (cdr bounds)) + (pulse-momentary-highlight-region (car bounds) (cdr bounds))))) + +(defun +avy@buffer-face (fn &rest r) + "AROUND advice for avy to dis/enable `buffer-face-mode'." + (if avy-all-windows + (walk-windows #'+avy@un-buffer-face nil (eq avy-all-windows 'all-frames))) + (condition-case e + (apply fn r) + ((quit error) (message "Avy: %S" e) nil) + (:sucess e)) + (if avy-all-windows + (walk-windows #'+avy@re-buffer-face nil (eq avy-all-windows 'all-frames)))) (define-minor-mode +avy-buffer-face-mode "Turn off `buffer-face-mode' before doing Avy selections. @@ -71,11 +89,9 @@ Restore the mode after the selection." (cond (+avy-buffer-face-mode (dolist (fn +avy-buffer-face-functions) - (advice-add fn :before #'+avy@un-buffer-face)) - (advice-add 'avy--done :after #'+avy@re-buffer-face)) + (advice-add fn :around #'+avy@buffer-face))) (t (dolist (fn +avy-buffer-face-functions) - (advice-remove fn #'+avy@un-buffer-face)) - (advice-remove 'avy--done #'+avy@re-buffer-face)))) + (advice-remove fn #'+avy@buffer-face))))) (provide '+avy) ;;; avy.el ends here diff --git a/lisp/+circe.el b/lisp/+circe.el index e8c5079..382f0ab 100644 --- a/lisp/+circe.el +++ b/lisp/+circe.el @@ -45,21 +45,27 @@ ;;; Channel information +(defvar-local +circe-current-topic "" + "Cached topic of the buffer's channel.") + (defun +circe-current-topic (&optional message) "Return the topic of the current channel. When called with optional MESSAGE non-nil, or interactively, also message the current topic." (interactive "p") (let ((topic - (save-excursion - (goto-char (point-max)) - (or (re-search-backward - (rx (group "*** " - (or "Topic" "topic" "TOPIC") - (* (not ":")) ": ") - (group (+ nonl))))) - (buffer-substring-no-properties - (match-beginning 2) (match-end 2))))) + (or (save-excursion + (goto-char (point-max)) + (and (re-search-backward + (rx (group "*** " + (or "Topic" "topic" "TOPIC") + (* (not ":")) ": ") + (group (+ nonl))) + nil t) + (buffer-substring-no-properties + (match-beginning 2) (match-end 2)))) + +circe-current-topic))) + (setq +circe-current-topic topic) (when message (message "%s" topic)) topic)) @@ -86,8 +92,8 @@ replace {nick} in the string with {NO-NICK}." "Make a formatting regex for CHAR delimiters. For entry into `lui-formatting-list'." `(rx (or bol whitespace) - (group ,char (+? (not (any whitespace ,char))) ,char) - (or eol whitespace))) + (group ,char (+? (not (any whitespace ,char))) ,char) + (or eol whitespace))) ;;; Hooks & Advice @@ -139,7 +145,7 @@ For entry into `lui-formatting-list'." "What to do with `circe-server' buffers when created.") (el-patch-defun circe (network-or-server &rest server-options) - "Connect to IRC. + "Connect to IRC. Connect to the given network specified by NETWORK-OR-SERVER. @@ -157,16 +163,16 @@ All SERVER-OPTIONS are treated as variables by getting the string locally in the server buffer. See `circe-network-options' for a list of common options." - (interactive (circe--read-network-and-options)) - (let* ((options (circe--server-get-network-options network-or-server - server-options)) - (buffer (circe--server-generate-buffer options))) - (with-current-buffer buffer - (circe-server-mode) - (circe--server-set-variables options) - (circe-reconnect)) - (el-patch-swap (pop-to-buffer-same-window buffer) - (funcall +circe-server-buffer-action buffer)))) + (interactive (circe--read-network-and-options)) + (let* ((options (circe--server-get-network-options network-or-server + server-options)) + (buffer (circe--server-generate-buffer options))) + (with-current-buffer buffer + (circe-server-mode) + (circe--server-set-variables options) + (circe-reconnect)) + (el-patch-swap (pop-to-buffer-same-window buffer) + (funcall +circe-server-buffer-action buffer)))) ;;; Chat commands @@ -177,7 +183,7 @@ See `circe-network-options' for a list of common options." nil t nil))) (circe-command-ME (format "slaps %s about a bit with a large trout" nick))) -;;; Filtering functions +;;; Filtering functions --- XXX: These don't work right. ;; Set `lui-input-function' to `+lui-filter', then add the filters you want to ;; `circe-channel-mode-hook'. diff --git a/lisp/+cus-edit.el b/lisp/+cus-edit.el index 7fa46d4..4631811 100644 --- a/lisp/+cus-edit.el +++ b/lisp/+cus-edit.el @@ -50,7 +50,7 @@ pass t to it." (cl-letf (((symbol-function 'custom-set-faces) 'ignore) ((symbol-function 'custom-set-variables) (lambda (&rest args) - (apply 'custom-theme-set-variables 'user + (apply #'custom-theme-set-variables 'user (seq-filter (lambda (el) (memq (car el) +custom-variable-allowlist)) diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 7c8a1a6..533d438 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -326,13 +326,24 @@ ARG is passed to `backward-kill-word'." (setq-default history-length t history-delete-duplicates t history-autosave-interval 60 - savehist-file (.etc "savehist.el")) + savehist-file (.etc "savehist.el") + ;; Other variables --- don't truncate any of these. + ;; `add-to-history' uses the values of these variables unless + ;; they're nil, in which case it falls back to `history-length'. + kill-ring-max 100 + mark-ring-max 100 + global-mark-ring-max 100 + regexp-search-ring-max 100 + search-ring-max 100 + kmacro-ring-max 100 + eww-history-limit 100) (dolist (var '(extended-command-history global-mark-ring + mark-ring kill-ring + kmacro-ring regexp-search-ring - search-ring - mark-ring)) + search-ring)) (add-to-list 'savehist-additional-variables var)) (savehist-mode +1)) diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el index b995b7e..22f8c82 100644 --- a/lisp/+flyspell-correct.el +++ b/lisp/+flyspell-correct.el @@ -2,10 +2,13 @@ ;;; Code: +(require 'flyspell-correct) + (defun +flyspell-correct-buffer (&optional prefix) "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. With PREFIX, prompt to change the current dictionary." (interactive "P") + (flyspell-buffer) (when prefix (let ((current-prefix-arg nil)) (call-interactively #'ispell-change-dictionary))) diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 026302b..11d6a4c 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el @@ -347,7 +347,7 @@ The order of elements matters: whichever one matches first is applied." (defun +modeline-line (&optional spacer) (when line-number-mode (+modeline-spacer nil spacer - "%l"))) + "%3l"))) (defun +modeline-column (&optional spacer) (when column-number-mode @@ -367,8 +367,8 @@ See `line-number-mode', `column-number-mode', and `file-percentage-mode'. If `+modeline-position-function' is set to a function in the current buffer, call that function instead." (cond ((functionp +modeline-position-function) - (+modeline-spacer nil spacer - (funcall +modeline-position-function))) + (when-let* ((str (funcall +modeline-position-function))) + (+modeline-spacer nil spacer str))) (t (funcall (+modeline-concat '(+modeline-region +modeline-line +modeline-column @@ -378,10 +378,9 @@ to a function in the current buffer, call that function instead." (defun +modeline-vc (&optional spacer) "Display the version control branch of the current buffer in the modeline." ;; from https://www.gonsie.com/blorg/modeline.html, from Doom - (if-let ((backend (vc-backend buffer-file-name))) + (when-let ((backend (vc-backend buffer-file-name))) (+modeline-spacer nil spacer - (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))) - "")) + (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))))) (defun +modeline-track (&optional spacer) "Display `tracking-mode' information." @@ -473,13 +472,16 @@ to a function in the current buffer, call that function instead." (kmacro-end-macro nil))))) 'mouse-face 'mode-line-highlight)))) +(defface +nyan-mode-line nil + "Face for nyan-cat in mode line.") + (defun +modeline-nyan-on-focused (&optional spacer) "Display the cat from `nyan-mode', but only on the focused window." (require 'nyan-mode) - (when (actually-selected-window-p) - (concat (or spacer "") (nyan-create) - (propertize "." - 'face 'font-lock-comment-face)))) + (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode)) + (actually-selected-window-p)) + (+modeline-spacer nil spacer + (propertize (nyan-create) 'face '+nyan-mode-line)))) (provide '+modeline) ;;; +modeline.el ends here diff --git a/lisp/+nyan-mode.el b/lisp/+nyan-mode.el new file mode 100644 index 0000000..fc6775b --- /dev/null +++ b/lisp/+nyan-mode.el @@ -0,0 +1,39 @@ +;;; +nyan-mode.el --- Extras for nyan-mode -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +;;; Update even without line number in the mode line. + +(defcustom +nyan-mode-update-functions + '( end-of-buffer beginning-of-buffer + next-line previous-line + org-next-visible-heading org-previous-visible-heading) + "Functions after which to force a mode-line update." + :type '(repeat function)) + +(defun +nyan-mode--fmlu (&rest _) + "Update the mode-line, advice-style." + (force-mode-line-update)) + +(defun +nyan-mode-advice (&rest _) + "Advise line-moving functions when in `nyan-mode'." + (dolist (fn +nyan-mode-update-functions) + (if nyan-mode + (advice-add fn :after #'+nyan-mode--fmlu) + (advice-remove fn #'+nyan-mode--fmlu)))) + +(define-minor-mode +nyan-local-mode + "My very own `nyan-mode' that isn't global and doesn't update the mode-line." + :global nil + :group 'nyan + (dolist (fn +nyan-mode-update-functions) + (if +nyan-local-mode + (advice-add fn :after #'+nyan-mode--fmlu) + (advice-remove fn #'+nyan-mode--fmlu)))) + +(define-globalized-minor-mode +nyan-mode +nyan-local-mode +nyan-local-mode) + +(provide '+nyan-mode) +;;; +nyan-mode.el ends here diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el index edd88f0..89b2708 100644 --- a/lisp/+org-wc.el +++ b/lisp/+org-wc.el @@ -87,7 +87,7 @@ code... probably).") (defun +org-wc-modeline () (cond ((eq +org-wc-word-count 'huge) "huge") - (+org-wc-word-count (format " %sw" (max 0 (+ +org-wc-word-count +org-wc-correction)))))) + (+org-wc-word-count (format "%sw" (max 0 (+ +org-wc-word-count +org-wc-correction)))))) (define-minor-mode +org-wc-mode "Count words in `org-mode' buffers in the mode-line." diff --git a/lisp/+org.el b/lisp/+org.el index 6b93a7a..0d6e300 100644 --- a/lisp/+org.el +++ b/lisp/+org.el @@ -2,6 +2,7 @@ ;;; Code: +(require 'el-patch) (require 'org) (require 'org-element) (require 'ox) @@ -96,7 +97,7 @@ appropriate. In tables, insert a new row or end the table." ;; for now, it works well enough. (cond ((and itemp emptyp) (delete-region (line-beginning-position) (line-end-position)) - (insert "\n\n")) + (insert "\n")) ((or first-item-p (and itemp (not emptyp)) item-child-p) @@ -252,11 +253,11 @@ instead of the true count." ((use-region-p) (message "%d words in region" (+org-count-words-stupidly (region-beginning) - (region-end)))) + (region-end)))) (t (message "%d words in buffer" (+org-count-words-stupidly (point-min) - (point-max)))))) + (point-max)))))) ;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ @@ -561,7 +562,7 @@ and POST-PROCESS are passed to `org-export-to-file'." (let ((org-tmp-file "/tmp/org.html")) (org-export-to-file 'html org-tmp-file async subtreep visible-only body-only ext-plist post-process) - (start-process "xclicp" "*xclip*" + (start-process "xclip" "*xclip*" "xclip" "-verbose" "-i" org-tmp-file "-t" "text/html" @@ -684,5 +685,49 @@ This should only fire when switching to a buffer from `org-agenda'." (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) + +;;; "Fix" `org-align-tags' + +(el-patch-defun org-align-tags (&optional all) + "Align tags in current entry. +When optional argument ALL is non-nil, align all tags in the +visible part of the buffer." + (let ((get-indent-column + (lambda () + (let ((offset (el-patch-swap + (if (bound-and-true-p org-indent-mode) + (* (1- org-indent-indentation-per-level) + (1- (org-current-level))) + 0) + 0))) + (+ org-tags-column + (if (> org-tags-column 0) (- offset) offset)))))) + (if (and (not all) (org-at-heading-p)) + (org--align-tags-here (funcall get-indent-column)) + (save-excursion + (if all + (progn + (goto-char (point-min)) + (while (re-search-forward org-tag-line-re nil t) + (org--align-tags-here (funcall get-indent-column)))) + (org-back-to-heading t) + (org--align-tags-here (funcall get-indent-column))))))) + +;;; Meta-return + +(defun +org-meta-return (&optional arg) + "Insert a new line, or wrap a region in a table. +See `org-meta-return', but `+org-return-dwim' does most of the +stuff I would want out of that function already. + +When called with a prefix ARG, will still unconditionally call +`org-insert-heading'." + (interactive "P") + (org-fold-check-before-invisible-edit 'insert) + (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations + (call-interactively (cond (arg #'org-insert-heading) + ((org-at-table-p) #'org-table-wrap-region) + (t #'org-return))))) + (provide '+org) ;;; +org.el ends here diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index 3e6968e..7ff991c 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el @@ -12,8 +12,8 @@ (defface +tab-bar-extra '((t :inherit (tab-bar font-lock-comment-face))) - "Tab bar face for extra information, like the menu-bar and time." - :group 'basic-faces) + "Tab bar face for extra information, like the menu-bar and time." + :group 'basic-faces) ;; Common @@ -35,97 +35,97 @@ (defun +tab-bar-tracking-mode () "Display `tracking-mode-line-buffers' in the tab-bar." ;; TODO: write something to convert a mode-line construct to a tab-bar - ;; construct. - (when (and (bound-and-true-p tracking-mode) - (not (and +tracking-hide-when-org-clocking - (bound-and-true-p org-clock-current-task)))) - (cons (when (> (length tracking-mode-line-buffers) 0) - '(track-mode-line-separator menu-item " " ignore)) - (cl-loop for i from 0 below (length tracking-mode-line-buffers) - as item = (nth i tracking-mode-line-buffers) - collect (append (list (intern (format "tracking-mode-line-%s" i)) - 'menu-item - (string-trim (format-mode-line item))) - (if-let ((keymap (plist-get item 'keymap))) - (list (alist-get 'down-mouse-1 (cdadr keymap))) - (list #'ignore)) - (when-let ((help (plist-get item 'help-echo))) - (list :help help))))))) + ;; construct. + (when (and (bound-and-true-p tracking-mode) + (not (and +tracking-hide-when-org-clocking + (bound-and-true-p org-clock-current-task)))) + (cons (when (> (length tracking-mode-line-buffers) 0) + '(track-mode-line-separator menu-item " " ignore)) + (cl-loop for i from 0 below (length tracking-mode-line-buffers) + as item = (nth i tracking-mode-line-buffers) + collect (append (list (intern (format "tracking-mode-line-%s" i)) + 'menu-item + (string-trim (format-mode-line item))) + (if-let ((keymap (plist-get item 'keymap))) + (list (alist-get 'down-mouse-1 (cdadr keymap))) + (list #'ignore)) + (when-let ((help (plist-get item 'help-echo))) + (list :help help))))))) (defun +tab-bar-timer () "Display `+timer-string' in the tab-bar." - (when +timer-string + (when (> (length (bound-and-true-p +timer-string)) 0) `((timer-string menu-item ,(concat " " +timer-string) - (lambda (ev) - (interactive "e") - (cond ((not +timer-timer) nil) - ((equal +timer-string +timer-running-string) - (popup-menu - '("Running timer" - ["Cancel timer" +timer-cancel t]) - ev)) - (t (setq +timer-string "")))))))) + (lambda (ev) + (interactive "e") + (cond ((not +timer-timer) nil) + ((equal +timer-string +timer-running-string) + (popup-menu + '("Running timer" + ["Cancel timer" +timer-cancel t]) + ev)) + (t (setq +timer-string "")))))))) (defun +tab-bar-date () "Display `display-time-string' in the tab-bar." (when display-time-mode `((date-time-string menu-item ,(substring-no-properties (concat " " (string-trim display-time-string))) - (lambda (ev) - (interactive "e") - (popup-menu - (append '("Timer") - (let (r) - (dolist (time '(3 5 10)) - (push (vector (format "Timer for %d minutes" time) - `(lambda () (interactive) - (+timer ,time)) - :active t) - r)) - (nreverse r)) - '(["Timer for ..." +timer t])) - ev)) - :help (discord-date-string))))) + (lambda (ev) + (interactive "e") + (popup-menu + (append '("Timer") + (let (r) + (dolist (time '(3 5 10)) + (push (vector (format "Timer for %d minutes" time) + `(lambda () (interactive) + (+timer ,time)) + :active t) + r)) + (nreverse r)) + '(["Timer for ..." +timer t])) + ev)) + :help (discord-date-string))))) (defun +tab-bar-notmuch-count () "Display a notmuch count in the tab-bar." (when (and (executable-find "notmuch") (featurep 'notmuch)) (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) - (next (cl-find "inbox" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) + (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) (next-count (plist-get next :count))) (when (and next-count (> next-count 0)) `((notmuch-count menu-item ,(format " |%s|" next-count) - ignore - :help ,(format "%s mails requiring attention." next-count))))))) + ignore + :help ,(format "%s mails requiring attention." next-count))))))) (defun +tab-bar-org-clock () "Display `org-mode-line-string' in the tab-bar." (when (and (fboundp 'org-clocking-p) (org-clocking-p)) ;; org-mode-line-string - `((org-clocking menu-item - ,org-mode-line-string - (lambda (ev) - (interactive "e") - (let ((menu (make-sparse-keymap - (or org-clock-current-task "Org-Clock")))) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (org-clock-menu)) - (message "%S" ev) - (popup-menu menu ev))) - :help ,(or (replace-regexp-in-string - (rx "[[" (group (* (not "]"))) - "][" (group (* (not "]"))) - "]]") - "\\2" - org-clock-current-task) - "Org-Clock"))))) + `((org-clocking menu-item + ,org-mode-line-string + (lambda (ev) + (interactive "e") + (let ((menu (make-sparse-keymap + (or org-clock-current-task "Org-Clock")))) + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (org-clock-menu)) + (message "%S" ev) + (popup-menu menu ev))) + :help ,(or (replace-regexp-in-string + (rx "[[" (group (* (not "]"))) + "][" (group (* (not "]"))) + "]]") + "\\2" + org-clock-current-task) + "Org-Clock"))))) (defcustom +tab-bar-emms-max-length 24 "Maximum length of `+tab-bar-emms'." @@ -139,8 +139,8 @@ (- +tab-bar-emms-max-length 2)))) `(emms-now-playing menu-item ,(concat "{" now-playing "}" " ") - emms-pause - ( :help ,(emms-mode-line-playlist-current)))))) + emms-pause + ( :help ,(emms-mode-line-playlist-current)))))) (defun +tab-bar-bongo () "Display Bongo now playing information." @@ -160,22 +160,22 @@ "\\1: \\3" (bongo-formatted-infoset)) ;; This isn't right - (- (min 50 (/ (frame-width) 3 )) 2))) + (- (min 50 (/ (frame-width) 3 )) 2))) "}") - (lambda () (interactive) - (let ((bongo-playlist-buffer - ;; XXX: I'm sure this is terribly inefficient - (cl-some (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p - 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - b))) - (buffer-list)))) - (with-bongo-playlist-buffer - (bongo-pause/resume)))) - :help ,(funcall bongo-header-line-function))))) + (lambda () (interactive) + (let ((bongo-playlist-buffer + ;; XXX: I'm sure this is terribly inefficient + (cl-some (lambda (b) + (with-current-buffer b + (when-let* ((modep (derived-mode-p + 'bongo-playlist-mode)) + (bongo-playlist-buffer b) + (playingp (bongo-playing-p))) + b))) + (buffer-list)))) + (with-bongo-playlist-buffer + (bongo-pause/resume)))) + :help ,(funcall bongo-header-line-function))))) (defvar +tab-bar-show-original nil "Original value of `tab-bar-show'.") @@ -192,49 +192,49 @@ ;;; FIXME this doesn't work... ;; (defvar +tab-bar-tab-min-width 8 -;; "Minimum width of a tab on the tab bar.") + ;; "Minimum width of a tab on the tab bar.") ;; (defvar +tab-bar-tab-max-width 24 -;; "Maximum width of a tab on the tab bar.") + ;; "Maximum width of a tab on the tab bar.") ;; (defun +tab-bar-fluid-calculate-width () -;; "Calculate the width of each tab in the tab-bar." -;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) -;; (tab-bar-avail-width (frame-width)) -;; (tab-bar-tab-count (length (tab-bar-tabs))) -;; (tab-bar-close-button-char-width 1) -;; (tab-bar-add-tab-button-char-width 1) -;; (tab-bar-total-width -;; (length (mapconcat -;; (lambda (el) -;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) -;; (substring-no-properties (eval str)))) -;; tab-bar-list))) -;; (tab-bar-total-tab-width -;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) -;; tab-bar-add-tab-button-char-width -;; (length (mapconcat -;; (lambda (el) -;; (substring-no-properties (alist-get 'name el))) -;; (tab-bar-tabs))))) -;; (tab-bar-total-nontab-width (- tab-bar-total-width -;; tab-bar-total-tab-width))) -;; (min +tab-bar-tab-max-width -;; (max +tab-bar-tab-min-width -;; (/ (- tab-bar-avail-width -;; tab-bar-total-tab-width -;; tab-bar-total-nontab-width) -;; tab-bar-tab-count))))) + ;; "Calculate the width of each tab in the tab-bar." + ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) + ;; (tab-bar-avail-width (frame-width)) + ;; (tab-bar-tab-count (length (tab-bar-tabs))) + ;; (tab-bar-close-button-char-width 1) + ;; (tab-bar-add-tab-button-char-width 1) + ;; (tab-bar-total-width + ;; (length (mapconcat + ;; (lambda (el) + ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) + ;; (substring-no-properties (eval str)))) + ;; tab-bar-list))) + ;; (tab-bar-total-tab-width + ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) + ;; tab-bar-add-tab-button-char-width + ;; (length (mapconcat + ;; (lambda (el) + ;; (substring-no-properties (alist-get 'name el))) + ;; (tab-bar-tabs))))) + ;; (tab-bar-total-nontab-width (- tab-bar-total-width + ;; tab-bar-total-tab-width))) + ;; (min +tab-bar-tab-max-width + ;; (max +tab-bar-tab-min-width + ;; (/ (- tab-bar-avail-width + ;; tab-bar-total-tab-width + ;; tab-bar-total-nontab-width) + ;; tab-bar-tab-count))))) ;; (defun +tab-bar-fluid-width () -;; "Generate the tab name to fluidly fit in the given space." -;; (let* ((tab-file-name (buffer-file-name (window-buffer -;; (minibuffer-selected-window))))) -;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) -;; (if tab-file-name -;; (file-name-nondirectory tab-file-name) -;; (+tab-bar-tab-name-truncated-left)) -;; " "))) + ;; "Generate the tab name to fluidly fit in the given space." + ;; (let* ((tab-file-name (buffer-file-name (window-buffer + ;; (minibuffer-selected-window))))) + ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) + ;; (if tab-file-name + ;; (file-name-nondirectory tab-file-name) + ;; (+tab-bar-tab-name-truncated-left)) + ;; " "))) (defun +tab-bar-tab-name-truncated-left () "Generate the tab name from the buffer of the selected window. @@ -259,13 +259,13 @@ name to the left." (defun +tab-bar-format-align-right () "Align the rest of tab bar items to the right, pixel-wise." ;; XXX: ideally, wouldn't require `shr' here - (require 'shr) ; `shr-string-pixel-width' - (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) - (rest (tab-bar-format-list rest)) - (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (shr-string-pixel-width rest)) - (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) - `((align-right menu-item ,str ignore)))) + (require 'shr) ; `shr-string-pixel-width' + (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) + (rest (tab-bar-format-list rest)) + (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) + (hpos (shr-string-pixel-width rest)) + (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) + `((align-right menu-item ,str ignore)))) ;;; Menu bar @@ -309,18 +309,18 @@ Used by `tab-bar-format-menu-bar'." `((current-tab menu-item ,(funcall tab-bar-tab-name-format-function tab i) - ignore - :help "Current tab"))) + ignore + :help "Current tab"))) (t `((,(intern (format "tab-%i" i)) - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ,(alist-get 'binding tab) - :help "Click to visit tab")))) + menu-item + ,(funcall tab-bar-tab-name-format-function tab i) + ,(alist-get 'binding tab) + :help "Click to visit tab")))) (when (alist-get 'close-binding tab) `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) - menu-item "" - ,(alist-get 'close-binding tab))))))) + menu-item "" + ,(alist-get 'close-binding tab))))))) ;; Emacs 27 @@ -334,7 +334,7 @@ This is :filter-return advice for `tab-bar-make-keymap-1'." ,reserve))))) (prog1 (append output `((align-right menu-item ,str nil)) - (+tab-bar-misc-info))))) + (+tab-bar-misc-info))))) ;; Emacs 28 @@ -353,27 +353,27 @@ This is :filter-return advice for `tab-bar-make-keymap-1'." (define-minor-mode +tab-bar-misc-info-mode "Show the `mode-line-misc-info' in the `tab-bar'." :lighter "" - :global t - (if +tab-bar-misc-info-mode - (progn ; Enable - (setq +tab-bar-show-original tab-bar-show) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq +tab-bar-format-original tab-bar-format) - (unless (memq '+tab-bar-misc-info tab-bar-format) - (setq tab-bar-format - (append tab-bar-format (+tab-bar-misc-info-28))))) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-add 'tab-bar-make-keymap-1 :filter-return - '+tab-bar-misc-info-27))) - (setq tab-bar-show t)) - (progn ; Disable - (setq tab-bar-show +tab-bar-show-original) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq tab-bar-format +tab-bar-format-original)) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) + :global t + (if +tab-bar-misc-info-mode + (progn ; Enable + (setq +tab-bar-show-original tab-bar-show) + (cond + ((boundp 'tab-bar-format) ; Emacs 28 + (setq +tab-bar-format-original tab-bar-format) + (unless (memq '+tab-bar-misc-info tab-bar-format) + (setq tab-bar-format + (append tab-bar-format (+tab-bar-misc-info-28))))) + ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 + (advice-add 'tab-bar-make-keymap-1 :filter-return + '+tab-bar-misc-info-27))) + (setq tab-bar-show t)) + (progn ; Disable + (setq tab-bar-show +tab-bar-show-original) + (cond + ((boundp 'tab-bar-format) ; Emacs 28 + (setq tab-bar-format +tab-bar-format-original)) + ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 + (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) diff --git a/lisp/+window.el b/lisp/+window.el new file mode 100644 index 0000000..52b3712 --- /dev/null +++ b/lisp/+window.el @@ -0,0 +1,130 @@ +;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Do I want to propose this change in the Emacs ML? + +;;; Code: + +(require 'window) + +;;; Split windows based on `window-total-width', not `window-width' +;; I have to just redefine these functions because the check is really deep in +;; there. + +(defun window-splittable-p (window &optional horizontal) + "Return non-nil if `split-window-sensibly' may split WINDOW. +Optional argument HORIZONTAL nil or omitted means check whether +`split-window-sensibly' may split WINDOW vertically. HORIZONTAL +non-nil means check whether WINDOW may be split horizontally. + +WINDOW may be split vertically when the following conditions +hold: +- `window-size-fixed' is either nil or equals `width' for the + buffer of WINDOW. +- `split-height-threshold' is an integer and WINDOW is at least as + high as `split-height-threshold'. +- When WINDOW is split evenly, the emanating windows are at least + `window-min-height' lines tall and can accommodate at least one + line plus - if WINDOW has one - a mode line. + +WINDOW may be split horizontally when the following conditions +hold: +- `window-size-fixed' is either nil or equals `height' for the + buffer of WINDOW. +- `split-width-threshold' is an integer and WINDOW is at least as + wide as `split-width-threshold'. +- When WINDOW is split evenly, the emanating windows are at least + `window-min-width' or two (whichever is larger) columns wide." + (when (and (window-live-p window) + (not (window-parameter window 'window-side))) + (with-current-buffer (window-buffer window) + (if horizontal + ;; A window can be split horizontally when its width is not + ;; fixed, it is at least `split-width-threshold' columns wide + ;; and at least twice as wide as `window-min-width' and 2 (the + ;; latter value is hardcoded). + (and (memq window-size-fixed '(nil height)) + ;; Testing `window-full-width-p' here hardly makes any + ;; sense nowadays. This can be done more intuitively by + ;; setting up `split-width-threshold' appropriately. + (numberp split-width-threshold) + (>= (window-total-width window) + (max split-width-threshold + (* 2 (max window-min-width 2))))) + ;; A window can be split vertically when its height is not + ;; fixed, it is at least `split-height-threshold' lines high, + ;; and it is at least twice as high as `window-min-height' and 2 + ;; if it has a mode line or 1. + (and (memq window-size-fixed '(nil width)) + (numberp split-height-threshold) + (>= (window-height window) + (max split-height-threshold + (* 2 (max window-min-height + (if mode-line-format 2 1)))))))))) + +(defun split-window-sensibly (&optional window) + "Split WINDOW in a way suitable for `display-buffer'. +WINDOW defaults to the currently selected window. +If `split-height-threshold' specifies an integer, WINDOW is at +least `split-height-threshold' lines tall and can be split +vertically, split WINDOW into two windows one above the other and +return the lower window. Otherwise, if `split-width-threshold' +specifies an integer, WINDOW is at least `split-width-threshold' +columns wide and can be split horizontally, split WINDOW into two +windows side by side and return the window on the right. If this +can't be done either and WINDOW is the only window on its frame, +try to split WINDOW vertically disregarding any value specified +by `split-height-threshold'. If that succeeds, return the lower +window. Return nil otherwise. + +By default `display-buffer' routines call this function to split +the largest or least recently used window. To change the default +customize the option `split-window-preferred-function'. + +You can enforce this function to not split WINDOW horizontally, +by setting (or binding) the variable `split-width-threshold' to +nil. If, in addition, you set `split-height-threshold' to zero, +chances increase that this function does split WINDOW vertically. + +In order to not split WINDOW vertically, set (or bind) the +variable `split-height-threshold' to nil. Additionally, you can +set `split-width-threshold' to zero to make a horizontal split +more likely to occur. + +Have a look at the function `window-splittable-p' if you want to +know how `split-window-sensibly' determines whether WINDOW can be +split." + (let ((window (or window (selected-window)))) + (or (and (window-splittable-p window) + ;; Split window vertically. + (with-selected-window window + (split-window-below))) + (and (window-splittable-p window t) + ;; Split window horizontally. + (with-selected-window window + (split-window-right))) + (and + ;; If WINDOW is the only usable window on its frame (it is + ;; the only one or, not being the only one, all the other + ;; ones are dedicated) and is not the minibuffer window, try + ;; to split it vertically disregarding the value of + ;; `split-height-threshold'. + (let ((frame (window-frame window))) + (or + (eq window (frame-root-window frame)) + (catch 'done + (walk-window-tree (lambda (w) + (unless (or (eq w window) + (window-dedicated-p w)) + (throw 'done nil))) + frame nil 'nomini) + t))) + (not (window-minibuffer-p window)) + (let ((split-height-threshold 0)) + (when (window-splittable-p window) + (with-selected-window window + (split-window-below)))))))) + +(provide '+window) +;;; +window.el ends here diff --git a/lisp/private.el b/lisp/private.el index f9c4753..4f6115e 100644 --- a/lisp/private.el +++ b/lisp/private.el @@ -15,5 +15,9 @@ "Private secretive secrets inside.") (add-to-list 'load-path private/) +;; Load random private stuff + +(require '_acdw) + (provide 'private) ;;; private.el ends here -- cgit 1.4.1-21-gabe81