diff options
Diffstat (limited to '.emacs')
| -rw-r--r-- | .emacs | 1011 |
1 files changed, 0 insertions, 1011 deletions
@@ -1,1011 +0,0 @@ -;;; -*- lexical-binding: t -*- - -;;; "Custom"ization & theming. - -;; Trying to migrate to use-package instead of Custom's serialized -;; forms. It's a long-term project; until that's done, start by -;; setting and loading the `custom-file'. -(setq custom-file "~/.emacs-custom.el") -(load custom-file) - -;; Compatibility shim for setopt. -(if (fboundp 'setopt) - (defalias 'my/setopt 'setopt) - (defmacro my/setopt (&rest pairs) - `(let ((pairs (quote ,pairs))) - (while pairs - (customize-set-variable (pop pairs) (pop pairs)))))) - -;; Helper for customizing list options. -;; -;; None of Emacs's customization tools (Custom, setopt, use-package) -;; can be told "add this element, take those two away": I need to "set -;; in stone" an exhaustive list that will make me (1) scratch my head -;; a few months later when I try to remember which of those items I -;; deliberately added vs which were part of the default list (2) miss -;; out on additions to the default list, unless I cautiously audit -;; every release of every package. -;; -;; Examples: erc-modules, git-commit-setup-hook, package-archives. -(defmacro my/setopt-update-list (l to-add &optional to-remove) - `(my/setopt ,l (thread-first - ,l (seq-union ,to-add) (seq-difference ,to-remove)))) - -(load-theme 'eighters t) - -;;; Key bindings. - -;; C-h is a special snowflake in many situations; this is the most -;; reliable way I found to consistently get C-h to do what DEL does. -;; -;; Likewise, C-M-h is re-bound by some major modes (CC, Python, Perl), -;; so this is the simplest way I know of to make sure C-M-h sticks as -;; "backward-kill-word". -;; -;; Same story with M-h (mark-paragraph) which gets re-bound by eg -;; markdown-mode and nxml-mode. -(define-key input-decode-map (kbd "C-h") (kbd "DEL")) -(define-key input-decode-map (kbd "C-M-h") (kbd "M-DEL")) - -(global-set-key (kbd "C-x C-b") 'ibuffer) - -(when (< emacs-major-version 28) - (defun my/other-window (count &optional all-frames) - (interactive "p") - (let ((repeat-map (make-sparse-keymap))) - (define-key repeat-map [?o] #'other-window) - (set-transient-map repeat-map t) - (other-window count all-frames))) - (global-set-key (kbd "C-x o") #'my/other-window)) - -;; Hopefully these will be easier to remember than TeX commands: - -(quail-define-package - "my/symbols" "UTF-8" "π°" t - "Input arbitrary Unicode symbols with other arbitrary symbols.") - -(pcase-dolist - (`(,key ,translation) - '(;; Punctuation - ("..." ?β¦) - ;; Math symbols - ("~~" ?β) ("~~=" ?β) ("~==" ?β
) ("~=" ?β) - ("==" ?β‘) ("^=" ?β) (":=" ?β) - ("<=" ?β€) (">=" ?β₯) - ("-->" ?β) ("-/>" ?β) ("==>" ?β) ("=/>" ?β) - ("<--" ?β) ("</-" ?β) ("<==" ?β) ("</=" ?β) - ("<->" ?β) ("<=>" ?β) - ;; Emojis - ("\\o/" ?π) ("\\m/" ?π€) - ;; Pictograms - ("/!\\" ?β ))) - (quail-defrule key translation "my/symbols")) - -(defmacro my/make-input-toggle (input-method) - (let ((fsym (intern (format "my/toggle-input-%s" input-method))) - ;; Unfortunately, by default `help-make-xrefs' does not try to - ;; cross-reference input methods, as `help-xref-mule-regexp' - ;; is nil. This can be worked around by setting this variable - ;; to `help-xref-mule-regexp-template'. - (doc (format "Toggle `%s' input method." input-method))) - `(defun ,fsym () - ,doc - (interactive) - ;; `current-input-method' is a string; if INPUT-METHOD is a - ;; symbol, neither eq, eql nor equal would return t. - (if (string= current-input-method ',input-method) - (deactivate-input-method) - (set-input-method ',input-method t))))) - -(defun my/set-tab-width (&optional arg) - (interactive "P") - (let ((new-width (cond (arg (prefix-numeric-value arg)) - ((= tab-width 4) 8) - (4))) - (old-width tab-width)) - ;; TODO: for some reason, set-variable takes effect immediately, - ;; but setq(-local)? do not: I need to move the cursor before tabs - ;; are re-drawn. - (set-variable 'tab-width new-width) - (message "changed from %s to %s" old-width new-width))) - -(defvar-local my/centered-width 'fill-column) -(defvar-local my/centered-set-right-margin nil) - -(defun my/centered--before-split (&optional _size window-to-split) - (let ((windows (if (frame-root-window-p window-to-split) - (window-list) - (list window-to-split)))) - (dolist (w windows) - (when (buffer-local-value 'my/centered-mode (window-buffer w)) - (set-window-margins w nil nil))))) - -(defun my/centered--around-splittable (splittable window &optional horizontal) - (if (and horizontal - (buffer-local-value 'my/centered-mode (window-buffer window))) - (let ((margins (window-margins window))) - (set-window-margins window nil nil) - (prog1 - (funcall splittable window horizontal) - (apply 'set-window-margins window margins))) - (funcall splittable window horizontal))) - -(advice-add 'split-window-right :before 'my/centered--before-split) -(advice-add 'window-splittable-p :around 'my/centered--around-splittable) - -(define-minor-mode my/centered-mode - "Update margins to keep content centered." - :init-value nil - (if my/centered-mode - (progn - (add-hook 'window-state-change-functions 'my/centered-set-margins nil t) - (dolist (win (get-buffer-window-list)) - (my/centered-set-margins win))) - (remove-hook 'window-state-change-functions 'my/centered-set-margins t) - (dolist (win (get-buffer-window-list)) - (set-window-margins win nil)))) - -(defun my/centered-set-margins (window) - (with-current-buffer (window-buffer window) - (let* ((target-body-width - (cond - ((symbolp my/centered-width) - (symbol-value my/centered-width)) - ((integerp my/centered-width) - my/centered-width))) - (adjustable-width - (- (window-total-width window) - (+ (fringe-columns 'left) (fringe-columns 'right)))) - (left-margin - (when (> adjustable-width target-body-width) - (/ (- adjustable-width target-body-width) 2))) - (right-margin (and my/centered-set-right-margin - left-margin))) - (set-window-margins window left-margin right-margin)))) - -(defun my/kill (stuff) - (kill-new stuff) - (message "%s" stuff)) - -;; TODO: my/kill-where -;; * filename -;; * absolute, project-relative (w/o project), namespace-relative, base -;; * function -;; * line number -;; * public URL - -;; TODO: my/kill-cite -;; * prefix: nil, >, | -;; * indent -;; * attribution: see my/kill-where -;; * concise: "(manual) Node", "manual(7)" -;; * executable: (info "(manual) Node"), "man 7 manual" -;; * <https://somewhe.re/manual.html#node> - -(defun my/read (prompt default) - (read-string (format-prompt prompt default) nil nil default)) - -(defvar my/run-strip-newline t - "Whether `my/run' will remove a trailing newline from a command's output.") - -(defun my/run (program &rest args) - "Return output from 'PROGRAM [ARGSβ¦]'. -Raise a user error if the command fails. Heed `my/run-strip-newline'." - (with-temp-buffer - (let* ((status (apply 'call-process program nil t nil args)) - (output (buffer-string))) - (if (eq status 0) - (if my/run-strip-newline - (string-remove-suffix "\n" output) - output) - (user-error "%s returned %d:\n%s" program status output))))) - -(defun my/kill-command (program &rest args) - "Send output from PROGRAM to kill-ring. -See `my/run' for details, e.g. status handling and output massaging." - (my/kill (apply 'my/run program args))) - -(defun my/kill-date (date format) - (interactive - (if current-prefix-arg - (list (my/read "Date spec?" "today") - (my/read "Format?" "%F")) - (list "today" "%F"))) - (my/kill-command "date" (concat "-d" date) (concat "+" format))) - -(defun my/kill-filename () - (interactive) - (my/kill (or (buffer-file-name) default-directory))) - -(defun my/kill-pipe-region (command) - (interactive (list (read-shell-command "Shell command on region: "))) - (let ((input (funcall region-extract-function nil))) - (with-temp-buffer - (insert input) - (call-process-region (point-min) (point-max) shell-file-name - t t nil shell-command-switch command) - (my/kill (buffer-string))))) - -(defun my/kill-shell (command) - "Send output from COMMAND to kill-ring. -Meant for interactive prompting for full commands passed to a shell. -For Lisp use, prefer `my/kill-command', where arguments are passed via a -list and require no escaping." - (interactive (list (read-shell-command "Shell command: "))) - (with-temp-buffer - (call-process-shell-command command nil t) - (my/kill (buffer-string)))) - -(defun my/shell-command-help (command) - (interactive - (list (read-shell-command "Show --help for: "))) - (let* ((command--help (concat command " --help")) - (help-buf (get-buffer-create (format "*%s*" command--help)))) - (shell-command (concat command--help) help-buf) - (display-buffer help-buf))) - -(defun my/magit-project () - (interactive) - (require 'project) - (magit-status (project-prompt-project-dir))) - -(defun my/magit-toggle-margin-date () - (interactive) - (let ((do-message - (lambda (old new) - (message - "%s β %s" - (propertize old 'face 'shadow) - (propertize new 'face 'bold))))) - (apply do-message (if magit-log-margin-show-committer-date - '("commit" "author") '("author" "commit"))) - (setq magit-log-margin-show-committer-date - (not magit-log-margin-show-committer-date)) - (revert-buffer))) - -(defmacro my/define-prefix-command (name doc bindings) - (declare (indent defun)) - `(defvar ,name - (let ((map (define-prefix-command ',name))) - (pcase-dolist (`(,key ,fun) ,bindings) - (define-key map key fun)) - map) - ,doc)) - -(my/define-prefix-command my/buffer-map - "Keymap for buffer manipulation commands." - '(("b" bury-buffer) - ("g" revert-buffer) - ("r" rename-buffer))) - -(my/define-prefix-command my/display-map - "Keymap for display-related commands." - '(("c" my/centered-mode) - ("l" hl-line-mode) - ("n" display-line-numbers-mode) - ("t" toggle-truncate-lines) - ("v" visual-line-mode))) - -(my/define-prefix-command my/editing-map - "Keymap for toggling editing features." - '(("f" auto-fill-mode))) - -(my/define-prefix-command my/magit-map - "Keymap for Magit commands." - '(("d" my/magit-toggle-margin-date) - ("f" magit-file-dispatch) - ("g" magit-status) - ("p" my/magit-project) - ("x" magit-dispatch) - ("\C-f" magit-find-file))) - -(my/define-prefix-command my/input-map - "Keymap for input methods shortcuts." - `(("e" ,(my/make-input-toggle emoji)) - ("t" ,(my/make-input-toggle TeX)) - ("u" ,(my/make-input-toggle my/symbols)))) - -(my/define-prefix-command my/kill-map - "Keymap for adding things to the kill ring." - '(("d" my/kill-date) - ("f" my/kill-filename) - ("|" my/kill-pipe-region) - ("!" my/kill-shell))) - -(my/define-prefix-command my/manual-map - "Keymap for reading manuals." - '(("h" my/shell-command-help) - ("i" info-display-manual) - ("m" man) - ("s" shortdoc-display-group))) - -(my/define-prefix-command my/whitespace-map - "Keymap for whitespace-related commands." - '(("c" whitespace-cleanup) - ("f" page-break-lines-mode) - ("m" whitespace-mode) - ("t" my/set-tab-width))) - -;; C-c [[:alpha:]] is reserved for users - let's make good use of it. - -(global-set-key (kbd "C-c b") 'my/buffer-map) -(global-set-key (kbd "C-c c") 'compile) -(global-set-key (kbd "C-c d") 'my/display-map) -(global-set-key (kbd "C-c e") 'my/editing-map) -(global-set-key (kbd "C-c g") 'my/magit-map) -(global-set-key (kbd "C-c i") 'my/input-map) -(global-set-key (kbd "C-c k") 'my/kill-map) -(global-set-key (kbd "C-c m") 'my/manual-map) -(global-set-key (kbd "C-c w") 'my/whitespace-map) - -(rg-enable-default-bindings) ; Uses the C-c s prefix. - -;; What's life without a little risk? -(setq disabled-command-function nil) - -;;; Window management. - -;; Bindings ala Terminator -(when window-system - (global-set-key (kbd "C-S-o") 'split-window-below) - (global-set-key (kbd "C-S-e") 'split-window-right) - (global-set-key (kbd "C-+") 'text-scale-adjust) - (global-set-key (kbd "C--") 'text-scale-adjust) - (global-set-key (kbd "C-0") 'text-scale-adjust) - (global-set-key (kbd "C-S-<up>") 'enlarge-window) - (global-set-key (kbd "C-S-<down>") 'shrink-window) - (global-set-key (kbd "C-S-<right>") 'enlarge-window-horizontally) - (global-set-key (kbd "C-S-<left>") 'shrink-window-horizontally)) - -;;; Lighters. - -(defun my/symbol-as-icon (c) - ;; By default, Emacs 28 uses color fonts for characters from (1) the - ;; 'emoji script (2) the 'symbol script, when followed by VS-16. - ;; Meanwhile, Emacs 27 knows how to display color fonts, but (1) it - ;; has no 'emoji script (2) it doesn't know what to do with VS-16. - ;; Bottomline: on Emacs 28, explicitly ask for the emoji - ;; presentation with VS-16; on older emacsen, just use the - ;; character, and rely on a blanket fontset rule to prefer color - ;; fonts for the whole 'symbol script. - (apply 'string `(,c ,@(when (>= emacs-major-version 28) - '(?\N{VARIATION SELECTOR-16}))))) - -;; So long, Will Mengarini. -(delight 'abbrev-mode nil 'abbrev) -(delight 'auto-fill-function "β" t) -(delight 'auto-revert-mode "β³" 'autorevert) -(delight 'auto-revert-tail-mode "β€" 'autorevert) -(delight 'footnote-mode "ΒΉ" 'footnote) -(delight 'flyspell-mode (propertize (my/symbol-as-icon ?π) - 'face 'flyspell-incorrect) - 'flyspell) -(delight 'hi-lock-mode nil 'hi-lock) -(delight 'hs-minor-mode "β¦" 'hideshow) -(delight 'mml-mode "π§" 'mml) -(delight 'page-break-lines-mode nil 'page-break-lines) -(delight 'scroll-lock-mode "π" 'scroll-lock) -(delight 'text-scale-mode - '(:eval (if (>= text-scale-mode-amount 0) "π" "π")) - 'face-remap) -(delight 'visual-line-mode nil t) -(delight 'with-editor-mode "βΈ" 'with-editor) -;; TODO: Narrow (β, βΆ) - -(if (< emacs-major-version 27) - (delight 'compilation-in-progress - (propertize "β" 'face 'compilation-mode-line-run) - 'compile) - (let* ((indicator (alist-get 'compilation-in-progress mode-line-modes)) - (old-props (text-properties-at 0 (car indicator))) - (face '(:inverse-video t :inherit compilation-mode-line-run)) - (new-props (append `(face ,face) old-props)) - (icon (my/symbol-as-icon ?β))) - (setcar indicator (concat (apply #'propertize icon new-props) " ")))) - -(setq eglot-menu-string "π¦»") - -(with-eval-after-load 'flymake - (let ((indicator (propertize (my/symbol-as-icon ?β) 'face 'flymake-error))) - ;; Prefer customizing the string instead delight'ing, as flymake - ;; slaps a bunch of helpful properties on top of the lighter, - ;; which delight would strip. - (if (boundp 'flymake-mode-line-lighter) - (setq flymake-mode-line-lighter indicator) - (delight 'flymake-mode indicator 'flymake)))) - -;;; Version control. - -(defvar my/git-commit-fill-columns - '((my/emacs-repo-p . 63))) - -(defun my/git-upstreams () - ;; TODO: memoize, perhaps? - (seq-uniq - (seq-keep - (lambda (remote-desc) - (and (string-match "\\`.*\t\\(.*\\) (fetch)\\'" remote-desc) - (match-string 1 remote-desc))) - (process-lines "git" "remote" "-v")))) - -(cl-defun my/git-commit-maybe-set-fill-column () - (let ((remotes (my/git-upstreams))) - (pcase-dolist (`(,pred . ,column) my/git-commit-fill-columns) - (when (funcall pred remotes) - (cl-return-from my/git-commit-maybe-set-fill-column - (setq fill-column column)))))) - -(defun my/revision-at-point () - (cond - ((derived-mode-p 'magit-mode) - (magit-branch-or-commit-at-point)) - ((derived-mode-p 'vc-git-log-view-mode) - (log-view-current-tag)) - ((derived-mode-p 'vc-annotate-mode) - (car (vc-annotate-extract-revision-at-line))))) - -(defun my/describe-revision (rev) - "Format a Git revision in a format suitable for changelogs." - (interactive - (list (my/read "Revision" (my/revision-at-point)))) - (my/kill-command - "git" "show" "--no-patch" "--date=short" "--format=%cd \"%s\" (%h)" rev)) - -;;; Major modes configuration. - -(defun my/c-modes-hook () - (c-set-style "bsd") - (c-set-offset 'arglist-close 0)) - -(add-hook 'c-mode-common-hook 'my/c-modes-hook) - -(defun my/calendar-iso-week (year month day) - ;; NIH version of `calendar-intermonth-text''s serving suggestion. - (propertize - (format-time-string "%V" (encode-time (list 0 0 0 day month year))) - 'font-lock-face 'eighters-date)) - -(defun my/compilation-notify (buffer results) - (let* ((title (buffer-name buffer)) - (status (if (string-equal results "finished\n") "success" "failure")) - (icon (format "%s/icons/compilation-%s.png" user-emacs-directory status))) - (require 'notifications) - (notifications-notify :title title :body results :app-icon icon :timeout 3000))) - -(add-to-list 'compilation-finish-functions 'my/compilation-notify) - -(defun my/make-tabless (f) - "Make a function which will run F with `indent-tabs-mode' disabled." - (lambda () - (:documentation (format "Run `%s' with `indent-tabs-mode' set to nil." f)) - (interactive) - (let ((indent-tabs-mode nil)) - (call-interactively f)))) - -(defun my/makefile-hook () - ;; I would rather align backslashes with spaces rather than tabs; - ;; however, I would also like indent-tabs-mode to remain non-nil. - (local-set-key (kbd "C-c C-\\") (my/make-tabless 'makefile-backslash-region)) - (local-set-key (kbd "M-q") (my/make-tabless 'fill-paragraph))) - -(add-hook 'makefile-mode-hook 'my/makefile-hook) - -(defun my/shell-hook () - (setq truncate-lines nil) - (setq-local recenter-positions '(top middle bottom))) - -(add-to-list 'ibuffer-saved-filter-groups - '("my/ibuffer-groups" - ("REPL" - (or (derived-mode . comint-mode) - (mode . lisp-interaction-mode))) - ("Programming" (derived-mode . prog-mode)) - ("Folders" (mode . dired-mode)) - ("Messaging" - (or (mode . erc-mode) - (mode . message-mode) - (derived-mode . gnus-mode))) - ("Documentation" - (or (mode . Info-mode) - (mode . Man-mode) - (mode . help-mode))) - ("Version control" - (or (derived-mode . magit-mode) - (name . "\\`\\*vc"))))) - -(add-hook 'ibuffer-mode-hook - (lambda () - (ibuffer-switch-to-saved-filter-groups "my/ibuffer-groups"))) - -;;; Development helpers. -(defun my/emacs-repo-p (upstreams) - "Guess whether we are working in the Emacs repository. -UPSTREAMS is a list of fetch URLs." - (member "https://git.savannah.gnu.org/git/emacs.git" upstreams)) - -(defun my/emacs-run-testcase () - (interactive) - (require 'which-func) - (let* ((emacs-root (project-root (project-current))) - (testfile (file-name-sans-extension - (file-relative-name - buffer-file-name (file-name-concat - emacs-root "test")))) - (cores (num-processors 'all)) - (options - `(("SELECTOR" . ,(which-function)) - ("TEST_BACKTRACE_LINE_LENGTH" . nil))) - (options-list - (seq-map - (lambda (opt) (format "%s=%s" (car opt) (cdr opt))) - options)) - (compile-command - (format "make -j%s && make -C test %s %s" - cores testfile (string-join options-list " ")))) - (call-interactively 'project-compile))) - -;;; Helper functions and miscellaneous settings. - -;;;; French quick toggle. -(defun my/froggify () - (ispell-change-dictionary "fr") - (setq-local colon-double-space nil) - (setq-local sentence-end-double-space nil) - (setq-local fill-nobreak-predicate - (cons 'fill-french-nobreak-p fill-nobreak-predicate)) - (setq-local my/froggified t)) - -(defun my/unfroggify () - (ispell-change-dictionary "default") - (setq-local colon-double-space t) - (setq-local sentence-end-double-space t) - (setq-local fill-nobreak-predicate - (remq 'fill-french-nobreak-p fill-nobreak-predicate)) - (setq-local my/froggified nil)) - -(defun my/croak () - (interactive) - (if (and (boundp 'my/froggified) my/froggified) - (my/unfroggify) - (my/froggify))) - -;;;; Mailing lists utilities. -(defun my/kill-message-id () - (interactive) - (my/kill (mail-header-message-id (gnus-summary-article-header)))) - -(defun my/describe-message (id url) - (my/kill (format "%s\n%s\n" - (if (string-prefix-p "<" id) - id - (format "<%s>" id)) - url))) - -(defun my/describe-message-id (list id) - "Format references from the Message-ID of a gnu.org list." - (interactive - (list - (read-string "List: ") ; TODO: default to current list. - (let ((default-id - (mail-header-message-id (gnus-summary-article-header)))) - (read-string (format-prompt "Message-ID" default-id) - nil nil default-id)))) - (with-current-buffer - (url-retrieve-synchronously - (concat - ;; For some reason, literal "+" chars cause the search to fail. - ;; Escape them. - "https://lists.gnu.org/archive/cgi-bin/namazu.cgi" - "?query=%2Bmessage-id:" - (replace-regexp-in-string "\\+" "%2B" id) - "&submit=Search!" - "&idxname=" list)) - (search-forward-regexp - (rx "<a href=\"" - (group "/archive/html/" (literal list) "/" - (+ (any "0-9-")) "/msg" (+ (any "0-9")) ".html") - "\">")) - (let ((url (concat "https://lists.gnu.org" (match-string 1)))) - (my/describe-message id url)))) - -(defun my/describe-message-url (url) - "Format references from an article archived on MHonArc." - (interactive - (list - (let ((default (or (thing-at-point 'url) - (and (derived-mode-p 'eww-mode) - (shr-url-at-point nil))))) - (read-string (format-prompt "URL" default) nil nil default)))) - (with-current-buffer (url-retrieve-synchronously url) - (search-forward-regexp "^<!--X-Message-Id: \\(.+\\) -->$") - (let ((id (xml-substitute-numeric-entities (match-string 1)))) - (my/describe-message id url)))) - -;;;; Font stuff π€·π€¦. -(when (= emacs-major-version 27) - ;; Emacs 27 added support for color fonts, but the default fontset - ;; did not use any such font for emoji. - (set-fontset-font t 'symbol "Noto Color Emoji" nil 'prepend) - ;; Make sure the default font does not get overzealous: β β. - ;; For Emacs 28, prefer VS-16: β οΈβοΈ. - (setq use-default-font-for-symbols nil)) - -;;;; Frame title. -(defun my/project-root () - (and-let* ((project (project-current))) - (project-root project))) - -(defun my/project-name () - (and-let* ((root (my/project-root)) - ;; Home is under VC to track dotfile changes. Not a - ;; "project" I want shown in the UI though. - ((not (file-equal-p root "~")))) - (file-name-nondirectory (directory-file-name root)))) - -(defun my/connection-name () - (let ((method (file-remote-p default-directory 'method))) - (pcase method - ;; No method: nil. - ('nil method) - ;; sudo(edit): just "METHOD". - ((pred (string-match-p "sudo")) method) - ;; Default: "METHOD:HOST". - (_ (format "%s:%s" method (file-remote-p default-directory 'host)))))) - -(defun my/frame-title-format () - (let ((prefix - ;; Messing with match data during redisplay is dangerous - ;; (cf. bug#33697). - (save-match-data - ;; For some reason, calling filename-parsing functions - ;; while TRAMP is busy opens the gates to Infinite - ;; Minibuffer Recursion Hell. Cautiously side-step that. - (or - (my/connection-name) - (my/project-name))))) - (concat (when prefix (format "[%s] " prefix)) - "%b"))) - -(setq frame-title-format '(:eval (my/frame-title-format))) - -;;;; Clipboard interaction. -(defun my/kill-as-html (text markup) - (interactive - (list (buffer-substring (region-beginning) (region-end)) - (or (alist-get major-mode '((markdown-mode . "markdown") - (org-mode . "org") - (rst-mode . "rst"))) - (let ((default "plain")) - (read-string (format-prompt "Convert from:" default) - nil nil default))))) - ;; TODO: make this a transient to easily (un)set pandoc extensions. - (with-temp-buffer - (call-process-region text nil "pandoc" nil t nil - "--from" markup "--to" "html") - ;; TODO: could `gui-set-selection' help here? The docstring makes - ;; it sound like passing a value with a 'text/html property set to - ;; the HTML string should work, but empirically it doesn't. - ;; Maybe look into `selection-converter-alist'. - (call-process-region nil nil "xclip" nil nil nil - "-selection" "clipboard" "-target" "text/html"))) - -(defun my/yank-from-html (html markup) - (interactive - (list - (gui-get-selection 'CLIPBOARD 'text/html) - (or (alist-get major-mode '((markdown-mode . "markdown") - (org-mode . "org") - (rst-mode . "rst"))) - (let ((default "plain")) - (read-string (format-prompt "Convert to:" default) - nil nil default))))) - ;; TODO: make this a transient to easily (un)set - ;; * extensions - ;; * switches (--wrap) - ;; * filters (remove all attributes) - (let* ((disabled-html-extensions (list - "native_divs" - "native_spans" - )) - (disabled-markup-extensions (list - ;; "smart" - )) - (html-spec - (funcall 'string-join `("html" ,@disabled-html-extensions) "-")) - (markup-spec - (funcall 'string-join `(,markup ,@disabled-markup-extensions) "-"))) - (call-process-region html nil "pandoc" nil t t - "--wrap=none" - "--from" html-spec "--to" markup-spec))) - -;;;; Miscellany. -(setq-default paragraph-start (concat "[ ]*- \\|" paragraph-start)) - -(defun my/screenshot (output) - (interactive - (list - (let ((default (format-time-string "/tmp/Emacs-Screenshot-%F-%T.pdf"))) - (read-file-name (format-prompt "Output?" default) nil default)))) - (let ((data (x-export-frames)) - (buf (find-file output))) - (insert data) - (save-buffer) - (kill-buffer buf))) - -;; Trying out use-package. - -(use-package use-package - :custom - (use-package-always-defer t)) - -(use-package package - :custom - (package-selected-packages - (append '(auctex - debbugs - delight - diff-hl - elisp-benchmarks - forge - gnus-mock - magit - markdown-mode - page-break-lines - rg - rust-mode - wgrep) - (when (< emacs-major-version 29) - '(eglot use-package)) - (when (< emacs-major-version 30) - '(which-key)))) - :config - (my/setopt-update-list - package-archives '(("melpa" . "https://melpa.org/packages/")))) - -(use-package calendar - :custom - (calendar-intermonth-text '(my/calendar-iso-week year month day)) - (calendar-today-visible-hook '(calendar-mark-today)) - (calendar-week-start-day 1)) - -(use-package diff-hl - :custom - (diff-hl-flydiff-mode t) - (global-diff-hl-mode t) - - ;; FIXME: Adding to these hooks _here_ clobbers them, i.e. they end - ;; up containing (a) the diff-hl functions (b) whatever functions - ;; their libraries add dynamically (c) *none* of the functions - ;; included in the defcustom's default value. - ;; - ;; Therefore, set these hooks up in the :config form _for the - ;; libraries that define these hooks_, so that (presumably) the - ;; default values for these hooks are loaded *before* adding the - ;; diff-hl functions. - ;; - ;; :hook - ;; ((dired-mode . diff-hl-dired-mode-unless-remote) - ;; (magit-pre-refresh . diff-hl-magit-pre-refresh) - ;; (magit-post-refresh . diff-hl-magit-post-refresh)) - ) - -(use-package dired - :custom - (dired-kill-when-opening-new-dired-buffer t) - (dired-listing-switches "-al -Fhv --group-directories-first") - :config - (add-hook 'dired-mode-hook 'diff-hl-dired-mode-unless-remote)) - -(use-package dired-aux - :custom - (dired-vc-rename-file t)) - -(use-package ediff - :custom - (ediff-merge-split-window-function 'split-window-vertically) - (ediff-split-window-function 'split-window-horizontally) - (ediff-window-setup-function 'ediff-setup-windows-plain)) - -(use-package eldoc - :delight "π") - -(use-package erc - :custom - (erc-log-channels-directory - (concat user-emacs-directory "erc/logs")) - (erc-log-write-after-insert t) - (erc-log-write-after-send t) - (erc-notifications-icon - (concat data-directory "images/icons/hicolor/scalable/apps/emacs.svg")) - (erc-prompt-for-nickserv-password nil) - (erc-prompt-for-password nil) - (erc-use-auth-source-for-nickserv-password t) - (erc-user-full-name 'user-full-name) - ;; Timestamps are a mess. - ;; - ;; The default `left-and-right' tries to keep timestamps flush right - ;; either with hard-spacing or with :align-to; both cause jank when - ;; splitting windows or rescaling faces. The default `left' does - ;; not do the separate-date-and-time thing. - ;; - ;; It may be possible to define my own function to do the - ;; date-if-changed-then-time-if-changed thing, but that would - ;; require a lot of cargo-culting of erc-stamp.el which, as of - ;; 30.0.50, makes this look more complex than I have patience for: - ;; an obsolete variable (`erc-stamp-prepend-date-stamps-p'), an - ;; internal minor mode (`erc-stamp--date-mode'), lots of text - ;; properties ('field, 'invisible)β¦ - ;; - ;; The options below seem like the least bad compromise, even though - ;; they yield a huge left margin interrupted by continuation lines; - ;; `erc-fill-wrap' _should_ help with those, except it causes - ;; impromptu recentering. `visual-wrap' could help here. - (erc-insert-timestamp-function 'erc-insert-timestamp-left) - (erc-timestamp-format "[%F %H:%M] ") - :config - (my/setopt-update-list erc-modules '(log notifications stamp track) '(fill)) - (my/setopt-update-list erc-track-exclude-types '("JOIN" "PART" "QUIT"))) - -(use-package forge - ;; Auto-load after Magit, to ensure `f n' works. - :after magit - ;; We have `use-package-always-defer' set, so `:after' does nothing - ;; unless we also set `:demand' (xref GH#572): - :demand t) - -(use-package generic-x - :demand t - :custom - (generic-extras-enable-list - '(etc-fstab-generic-mode - etc-modules-conf-generic-mode - etc-passwd-generic-mode - etc-services-generic-mode - etc-sudoers-generic-mode - hosts-generic-mode - pkginfo-generic-mode - resolve-conf-generic-mode - x-resource-generic-mode))) - -(use-package git-commit - :config - (my/setopt-update-list - git-commit-setup-hook '(git-commit-turn-on-flyspell - my/git-commit-maybe-set-fill-column))) - -(use-package isearch - :delight "π" - :custom - (isearch-allow-scroll t) - (isearch-lazy-count t) - (search-default-mode 'char-fold-to-regexp)) - -(use-package magit - :custom - (magit-define-global-key-bindings nil) - (magit-diff-refine-hunk t) - (magit-ediff-dwim-show-on-hunks t) - (magit-revision-show-gravatars t) - :config - (setq magit-process-finish-apply-ansi-colors t) - ;; See `diff-hl' form for rationale. - (add-hook 'magit-pre-refresh-hook 'diff-hl-magit-pre-refresh) - (add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh)) - -(use-package magit-blame - :delight "π") - -(use-package markdown-mode - :custom - (markdown-asymmetric-header t) - (markdown-command "pandoc -s") - (markdown-enable-math t) - (markdown-header-scaling t) - (markdown-indent-on-enter 'indent-and-new-item)) - -(use-package message - :custom - (message-confirm-send t)) - -;; Gripes: -;; - underused keys: C-M-i, C-j -;; - (minibuffer-)choose-completion ignore completion-no-auto-exit -;; when the candidate is a directory: the candidate is inserted in -;; the minibuffer and the user does *not* exit the minibuffer. -;; -;; In minibuffer: -;; - TAB complete, or show/update completions -;; - TABΒ² jump to completions -;; - C-M-n, C-M-p highlight candidate (without changing minibuffer) -;; - RET, C-j accept minibuffer input -;; - M-RET accept highlighted candidate -;; - C-u M-RET insert highlighted candidate (without accepting) -;; -;; In completions: -;; - n, TAB, p highlight candidate (without changing minibuffer) -;; - RET accept highlighted candidate -;; - C-u RET insert highlighted candidate in minibuffer (without accepting) -;; - C-g, q back to minibuffer -(use-package minibuffer - :config - (setq completion-ignore-case t) - (define-key completion-in-region-mode-map (kbd "C-M-n") 'minibuffer-next-completion) - (define-key completion-in-region-mode-map (kbd "C-M-p") 'minibuffer-previous-completion) - (define-key minibuffer-mode-map (kbd "C-M-n") 'minibuffer-next-completion) - (define-key minibuffer-mode-map (kbd "C-M-p") 'minibuffer-previous-completion) - :custom - (completion-auto-help 'visible) - (completion-auto-select 'second-tab) - (completion-pcm-leading-wildcard t) - (completion-show-help nil) - (completions-detailed t) - (completions-format 'one-column) - (completions-group t) - (completions-max-height 10) - (minibuffer-completion-auto-choose nil) - (read-buffer-completion-ignore-case t) - (read-file-name-completion-ignore-case t)) - -(use-package org - :config - (when (version< org-version "9.4") - (define-key org-mode-map (kbd "C-j") 'org-return) - (define-key org-mode-map (kbd "RET") 'org-return-indent)) - :custom - (org-edit-src-content-indentation 0) - (org-ellipsis "β¦") - (org-fontify-done-headline nil) - (org-fontify-quote-and-verse-blocks t) - (org-goto-interface 'outline-path-completion) - (org-startup-indented t) - (org-use-extra-keys t) - (org-use-speed-commands t) - ;; Make org-refile a bit more eager. - (org-outline-path-complete-in-steps nil) - (org-refile-targets '((nil . (:maxlevel . 10)))) - (org-refile-use-outline-path t)) - -(use-package org-indent - :delight "Β»") - -(use-package paren - :custom - (show-paren-mode t) - (show-paren-predicate t)) - -(use-package python - :custom - (python-fill-docstring-style 'pep-257-nn) - (python-forward-sexp-function nil) - (python-indent-def-block-scale 1)) - -(use-package shell - :config - (setq shell-font-lock-keywords nil) - (add-hook 'shell-mode-hook 'my/shell-hook)) - -(use-package shr - :custom - ;; Prefer visual-line-mode, which refills text automatically when - ;; the window width changes. - (shr-fill-text nil)) - -(use-package which-key - :custom - (which-key-dont-use-unicode nil) - (which-key-idle-delay 0.5) - (which-key-mode t) - :delight) - -(use-package whitespace - :config - (my/setopt-update-list whitespace-style nil '(lines missing-newline-at-eof)) - :delight - ;; FIXME: without :demand t, enabling whitespace-mode in a diff - ;; buffer first causes diff-mode's settings to be applied globally. - :demand t) - -;;; TODO: -;; * decruftify mode-line (e.g. remove superflous parens). -;; * teach some modes to give better names to their buffers to reduce -;; clobbering: info, occur |