acdw/emacs
acdw
/
emacs
1
2
Fork 0
Code Issues 4 Pull Requests Releases Activity

blep

This commit is contained in:
Case Duckworth 2022-06-08 17:59:53 -05:00
parent 2c8a3306db
commit af3eb37c8e
15 changed files with 634 additions and 314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
early-init.el
View File

@ -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

212
init.el
View File

@ -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-<backspace>" #'+backward-kill-word
"C-x TAB" #'+indent-rigidly
"<f7>" #'flyspell-mode
"C-x C-c" #'+save-buffers-quit)
;; Disable bindings
(:global "M-j" nil
"<Scroll_Lock>" 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
"<S-return>" #'+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)))

51
lisp/+apheleia.el
View File

@ -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

40
lisp/+avy.el
View File

@ -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

52
lisp/+circe.el
View File

@ -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'.

2
lisp/+cus-edit.el
View File

@ -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))

17
lisp/+emacs.el
View File

@ -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))

3
lisp/+flyspell-correct.el
View File

@ -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)))

22
lisp/+modeline.el
View File

@ -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

39
lisp/+nyan-mode.el Normal file
View File

@ -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

2
lisp/+org-wc.el
View File

@ -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."

53
lisp/+org.el
View File

@ -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

314
lisp/+tab-bar.el
View File

@ -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))))))

130
lisp/+window.el Normal file
View File

@ -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

4
lisp/private.el
View File

@ -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