;;; acdw.el --- miscellaneous -*- lexical-binding: t; coding: utf-8-unix -*- ;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> ;; Created: Sometime during Covid-19, 2020 ;; Keywords: configuration ;; URL: https://tildegit.org/acdw/emacs ;; This file is NOT part of GNU Emacs. ;;; License: ;; Everyone is permitted to do whatever with this software, without ;; limitation. This software comes without any warranty whatsoever, ;; but with two pieces of advice: ;; - Don't hurt yourself. ;; - Make good choices. ;;; Commentary: ;; `acdw.el' contains `acdw/map', its mode, and assorted ease-of-life ;; functions for me, acdw. ;;; Code: (require 'cl-lib) (require 'auth-source) (require 'recentf) ;;; Variables (defconst acdw/system (pcase system-type ('gnu/linux :home) ((or 'msdos 'windows-nt) :work) (_ :other)) "Which computer system is currently being used.") (defmacro acdw/system (&rest args) "Macro for interfacing, depending on ARGS, with symbol `acdw/system'. When called without arguments, it returns symbol `acdw/system'. When called with one (symbol) argument, it returns (eq acdw/system ARG). When called with multiple arguments or a list, it returns `pcase' over each argument." (cond ((null args) acdw/system) ((atom (car args)) `(when (eq acdw/system ,(car args)) ,(car args))) (t `(pcase acdw/system ,@args)))) ;;; Utility functions ;; I don't prefix these because ... reasons. Honestly I probably should prefix ;; them. (defun truncate-string (len str &optional ellipsis) "If STR is longer than LEN, cut it down and add ELLIPSIS to the end. When not specified, ELLIPSIS defaults to '...'." (declare (pure t) (side-effect-free t)) (unless ellipsis (setq ellipsis "...")) (if (> (length str) len) (format "%s%s" (substring str 0 (- len (length ellipsis))) ellipsis) str)) ;; Why isn't this a thing??? (defmacro fbound-and-true-p (func) "Return the value of function FUNC if it is bound, else nil." `(and (fboundp ,func) ,func)) (defmacro when-unfocused (name &rest forms) "Define a function NAME, executing FORMS, for when Emacs is unfocused." (declare (indent 1)) (let ((func-name (intern (concat "when-unfocused-" (symbol-name name))))) `(progn (defun ,func-name () "Defined by `when-unfocused'." (when (seq-every-p #'null (mapcar #'frame-focus-state (frame-list))) ,@forms)) (add-function :after after-focus-change-function #',func-name)))) (defmacro with-eval-after-loads (features &rest body) "Execute BODY after FEATURES are loaded. This macro simplifies `with-eval-after-load' for multiple nested features." (declare (indent 1) (debug (form def-body))) (unless (listp features) (setq features (list features))) (if (null features) (macroexp-progn body) (let* ((this (car features)) (rest (cdr features))) `(with-eval-after-load ',this (with-eval-after-loads ,rest ,@body))))) (defmacro with-message (message &rest body) "Execute BODY, messaging 'MESSAGE...' before and 'MESSAGE... Done.' after." (declare (indent 1)) ;; Wrap a progn inside a prog1 to return the return value of the body. `(prog1 (progn (message "%s..." ,message) ,@body) (message "%s... Done." ,message))) (defun clone-buffer-write-file (filename &optional confirm) "Clone current buffer to a file named FILENAME and switch. FILENAME and CONFIRM are passed directly to `write-file'." (interactive ; stolen from `write-file' (list (if buffer-file-name (read-file-name "Write file: " nil nil nil nil) (read-file-name "Write file: " default-directory (expand-file-name (file-name-nondirectory (buffer-name)) default-directory) nil nil)) (not current-prefix-arg))) (let ((buf (clone-buffer nil nil))) (with-current-buffer buf (write-file filename confirm)) (switch-to-buffer buf))) ;; https://old.reddit.com/r/emacs/comments/pjwkts (defun acdw/goto-last-row () "Move point to last row of buffer, but save the column." (interactive) (let ((col (current-column))) (goto-char (point-max)) (move-to-column col t))) (defun acdw/goto-first-row () "Move point to first row of buffer, but save the column." (interactive) (let ((col (current-column))) (goto-char (point-min)) (move-to-column col t))) (defun dos2unix (buffer) "Replace \r\n with \n in BUFFER." (interactive "*b") (save-excursion (with-current-buffer buffer (goto-char (point-min)) (while (search-forward (string ?\C-m ?\C-j) nil t) (replace-match (string ?\C-j) nil t))))) (defun expand-file-name-exists-p (&rest args) "Return `expand-file-name' ARGS if it exists, or nil." (let ((file (apply #'expand-file-name args))) (if (file-exists-p file) file nil))) (defun kill-region-or-backward-word (arg) "If region is active, kill; otherwise kill word backward with ARG." (interactive "p") (if (region-active-p) (kill-region (region-beginning) (region-end)) (if (bound-and-true-p paredit-mode) (paredit-backward-kill-word) (backward-kill-word arg)))) (defun unfill-buffer (&optional buffer-or-name) "Unfill entire contents of BUFFER-OR-NAME." (with-current-buffer (or buffer-or-name (current-buffer)) (save-excursion (save-restriction (unfill-region (point-min) (point-max)))))) (defun waterfall-list (car list rest) "Cons CAR with each element in LIST in a waterfall fashion, end with REST. For use with the `with-eval-after-loads' function." (cond ((atom list) `(,car ',list ,@rest)) ((= 1 (length list)) `(,car ',(car list) ,@rest)) (t `(,car ',(car list) ,(waterfall-list car (cdr list) rest))))) ;;; Comment-or-uncomment-sexp ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html (defun uncomment-sexp (&optional n) "Uncomment N sexps around point." (interactive "P") (let* ((initial-point (point-marker)) (inhibit-field-text-motion t) (p) (end (save-excursion (when (elt (syntax-ppss) 4) (re-search-backward comment-start-skip (line-beginning-position) t)) (setq p (point-marker)) (comment-forward (point-max)) (point-marker))) (beg (save-excursion (forward-line 0) (while (and (not (bobp)) (= end (save-excursion (comment-forward (point-max)) (point)))) (forward-line -1)) (goto-char (line-end-position)) (re-search-backward comment-start-skip (line-beginning-position) t) (ignore-errors (while (looking-at-p comment-start-skip) (forward-char -1))) (point-marker)))) (unless (= beg end) (uncomment-region beg end) (goto-char p) ;; Indentify the "top-level" sexp inside the comment. (while (and (ignore-errors (backward-up-list) t) (>= (point) beg)) (skip-chars-backward (rx (syntax expression-prefix))) (setq p (point-marker))) ;; Re-comment everything before it. (ignore-errors (comment-region beg p)) ;; And everything after it. (goto-char p) (forward-sexp (or n 1)) (skip-chars-forward "\r\n[:blank:]") (if (< (point) end) (ignore-errors (comment-region (point) end)) ;; If this is a closing delimiter, pull it up. (goto-char end) (skip-chars-forward "\r\n[:blank:]") (when (eq 5 (car (syntax-after (point)))) (delete-indentation)))) ;; Without a prefix, it's more useful to leave point where ;; it was. (unless n (goto-char initial-point)))) (defun comment-sexp--raw () "Comment the sexp at point or ahead of point." (pcase (or (bounds-of-thing-at-point 'sexp) (save-excursion (skip-chars-forward "\r\n[:blank:]") (bounds-of-thing-at-point 'sexp))) (`(,l . ,r) (goto-char r) (skip-chars-forward "\r\n[:blank:]") (save-excursion (comment-region l r)) (skip-chars-forward "\r\n[:blank:]")))) (defun comment-or-uncomment-sexp (&optional n) "Comment the sexp at point and move past it. If already inside (or before) a comment, uncomment instead. With a prefix argument N, (un)comment that many sexps." (interactive "P") (if (or (elt (syntax-ppss) 4) (< (save-excursion (skip-chars-forward "\r\n[:blank:]") (point)) (save-excursion (comment-forward 1) (point)))) (uncomment-sexp n) (dotimes (_ (or n 1)) (comment-sexp--raw)))) ;;; Sort sexps ;; from https://github.com/alphapapa/unpackaged.el#sort-sexps ;; and https://github.com/alphapapa/unpackaged.el/issues/20 (defun sort-sexps (beg end &optional key-fn sort-fn) "Sort sexps between BEG and END. Comments stay with the code below. Optional argument KEY-FN will determine where in each sexp to start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) Optional argument SORT-FN will determine how to sort two sexps' strings. It's passed to `sort'. By default, it sorts the sexps with `string<' starting with the key determined by KEY-FN." (interactive "r") (cl-flet ((skip-whitespace () (while (looking-at (rx (1+ (or space "\n")))) (goto-char (match-end 0)))) (skip-both () (while (cond ((or (nth 4 (syntax-ppss)) (ignore-errors (save-excursion (forward-char 1) (nth 4 (syntax-ppss))))) (forward-line 1)) ((looking-at (rx (1+ (or space "\n")))) (goto-char (match-end 0))))))) (save-excursion (save-restriction (narrow-to-region beg end) (goto-char beg) (skip-both) (cl-destructuring-bind (sexps markers) (cl-loop do (skip-whitespace) for start = (point-marker) for sexp = (ignore-errors (read (current-buffer))) for end = (point-marker) while sexp ;; Collect the real string, then one used for sorting. collect (cons (buffer-substring (marker-position start) (marker-position end)) (save-excursion (goto-char (marker-position start)) (skip-both) (if key-fn (funcall key-fn sexp) (buffer-substring (point) (marker-position end))))) into sexps collect (cons start end) into markers finally return (list sexps markers)) (setq sexps (sort sexps (if sort-fn sort-fn (lambda (a b) (string< (cdr a) (cdr b)))))) (cl-loop for (real . sort) in sexps for (start . end) in markers do (progn (goto-char (marker-position start)) (insert-before-markers real) (delete-region (point) (marker-position end))))))))) (defun acdw/sort-setups () "Sort `setup' forms in the current buffer. Actually sorts all forms, but based on the logic of `setup'. In short, DO NOT USE THIS FUNCTION!!!" (save-excursion (sort-sexps (point-min) (point-max) ;; Key function nil ;; Sort function (lambda (s1 s2) ; oh god, this is worse. (let* ((s1 (cdr s1)) (s2 (cdr s2)) ; for the strings themselves (require-regexp (rx bos (* nonl) ":require")) (straight-regexp (rx bos (* nonl) ":straight")) (s1-require (string-match require-regexp s1)) (s2-require (string-match require-regexp s2)) (s1-straight (string-match straight-regexp s1)) (s2-straight (string-match straight-regexp s2))) (cond ;; Straight forms require some weirdness ((and s1-straight s2-straight) (let* ((r (rx ":straight" (? "-if") (* space) (? "("))) (s1 (replace-regexp-in-string r "" s1)) (s2 (replace-regexp-in-string r "" s2))) (string< s1 s2))) ;; requires should go first ((and s1-require (not s2-require)) t) ((and (not s1-require) s2-require) nil) ;; straights should go last ((and s1-straight (not s2-straight)) nil) ((and (not s1-straight) s2-straight) t) ;; else, just sort em. (t (string< s1 s2)))))))) ;;; Emacs configuration functions (defun emacs-git-pull-config (&optional remote branch) "`git-pull' Emacs' configuration from REMOTE and BRANCH. REMOTE defaults to 'origin', BRANCH to 'main'." (let ((remote (or remote "origin")) (branch (or branch "main"))) (with-message (format "Pulling Emacs's configuration from %s" branch) (shell-command (concat "git -C " "\"" (expand-file-name user-emacs-directory) "\"" " pull " remote " " branch) (get-buffer-create "*emacs-git-pull-config-output*") (get-buffer-create "*emacs-git-pull-config-error*"))))) (defun emacs-reload (&optional git-pull-first) "Reload Emacs's configuration files. With a prefix argument GIT-PULL-FIRST, run git pull on the repo first." (interactive "P") (when git-pull-first (emacs-git-pull-config)) (let ((init-files (append ;; Load lisp libraries first, in case their functionality ;; is used by {early-,}init.el (let* ((dir (expand-file-name "lisp/" user-emacs-directory)) (full-name (lambda (f) (concat (file-name-as-directory dir) f)))) (mapcar full-name (directory-files dir nil "\\.el\\'"))) ;; Load regular init files (list (locate-user-emacs-file "early-init.el") (locate-user-emacs-file "init.el" ".emacs")))) (debug-on-error t)) (with-message "Saving init files" (save-some-buffers :no-confirm (lambda () (member (buffer-file-name) init-files)))) (dolist (file init-files) (with-message (format "Loading %s" file) (when (file-exists-p file) (load-file file)))))) ;;; Specialized functions (defun acdw/copy-region-plain (beg end) "Copy a region from BEG to END to clipboard, removing all Org formatting." (interactive "r") (let ((s (buffer-substring-no-properties beg end)) (extracted-heading (when (derived-mode-p 'org-mode) (acdw/org-extract-heading-text)))) (with-temp-buffer (insert s) (let ((sentence-end-double-space nil)) ;; Remove org stuff (when extracted-heading ; Replace org heading with plaintext (goto-char (point-min)) (kill-line) (insert extracted-heading)) ;; Delete property drawers (replace-regexp org-property-drawer-re "") ;; Delete logbook drawers (replace-regexp org-logbook-drawer-re "") ;; Replace list items with their contents, paragraphed (replace-regexp org-list-full-item-re " \4") ;; Delete comment lines (replace-regexp (concat org-comment-regexp ".*$") "") ;; Re-fill text for clipboard (unfill-region (point-min) (point-max)) (flush-lines "^$" (point-min) (point-max))) ;; Copy buffer (copy-region-as-kill (point-min) (point-max)))) (when (called-interactively-p 'interactive) (indicate-copied-region)) (setq deactivate-mark t) nil) ;; https://emacs.stackexchange.com/questions/36366/ (defun html-body-id-filter (output backend info) "Remove random ID attributes generated by Org." (when (eq backend 'html) (replace-regexp-in-string " id=\"[[:alpha:]-]*org[[:alnum:]]\\{7\\}\"" "" output t))) (defun html-body-div-filter (output backend info) "Remove wrapping divs generated by Org." (when (eq backend 'html) (replace-regexp-in-string "]*>\n*" "" output t))) (defun org-demote-headings (backend) (while (/= (point) (point-max)) (org-next-visible-heading 1) (org-demote-subtree))) (defun acdw/org-export-copy-html () "Copy a tree as HTML." (interactive) (require 'ox-html) (org-export-with-buffer-copy ;; (add-hook 'org-export-before-parsing-hook #'org-demote-headings nil t) (let ((extracted-heading (acdw/org-extract-heading-text)) (org-export-show-temporary-export-buffer nil) (org-export-filter-final-output-functions '(html-body-id-filter html-body-div-filter)) (org-export-with-smart-quotes nil) (org-export-smart-quotes-alist nil)) (insert "* ORG IS STUPID SOMETIMES\n") (goto-char (point-min)) (org-html-export-as-html nil t nil t) (with-current-buffer "*Org HTML Export*" (goto-char (point-min)) (replace-regexp "

.*

" "") (insert "

" extracted-heading "

") (flush-lines "^$" (point-min) (point-max)) (let ((sentence-end-double-space nil)) (unfill-region (point-min) (point-max))) (replace-regexp " +" "

" nil (point-min) (point-max)) (replace-regexp " +

" "

" nil (point-min) (point-max)) (copy-region-as-kill (point-min) (point-max))))) (when (called-interactively-p 'interactive) (indicate-copied-region)) (setq deactivate-mark t) nil) (defun acdw/org-export-copy () "copy a tree" (interactive) (require 'ox-ascii) (let ((extracted-heading (acdw/org-extract-heading-text))) ;; Export to ASCII - not async, subtree only, visible-only, body-only (let ((org-export-show-temporary-export-buffer nil)) (org-ascii-export-as-ascii nil t nil t)) (with-current-buffer "*Org ASCII Export*" (goto-char (point-min)) (insert extracted-heading) (newline 2) (replace-regexp org-list-full-item-re " \4") (let ((sentence-end-double-space nil)) (unfill-region (point-min) (point-max))) (flush-lines "^$" (point-min) (point-max)) (copy-region-as-kill (point-min) (point-max))) (when (called-interactively-p 'interactive) (indicate-copied-region)) (setq deactivate-mark t) nil)) (defun acdw/org-extract-heading-text () "Extract the heading text from an `org-mode' heading." (let ((heading (org-no-properties (org-get-heading t t t t)))) (message (replace-regexp-in-string org-link-bracket-re (lambda (match) (match-string-no-properties 2 match)) heading)))) (defun acdw/sync-dir (&optional file make-directory) "Return FILE from ~/Sync. Optional argument MAKE-DIRECTORY makes the directory. Logic is as in `acdw/dir', which see." (let ((dir (expand-file-name (convert-standard-filename "~/Sync/")))) (if file (let ((file-name (expand-file-name (convert-standard-filename file) dir))) (when make-directory (make-directory (file-name-directory file-name) 'parents)) file-name) dir))) (defun acdw/dir (&optional file make-directory) "Place Emacs files in one place. If called without parameters, `acdw/dir' expands to ~/.emacs.d/var or similar. If called with FILE, `acdw/dir' expands FILE to ~/.emacs.d/var, optionally making its directory if MAKE-DIRECTORY is non-nil." (let ((dir (expand-file-name (convert-standard-filename "var/") user-emacs-directory))) (if file (let ((file-name (expand-file-name (convert-standard-filename file) dir))) (when make-directory (make-directory (file-name-directory file-name) 'parents)) file-name) dir))) (defun acdw/find-emacs-source () ;; doesn't work right now "Find where Emacs' source tree is." (acdw/system (:work (expand-file-name (concat "~/src/emacs-" emacs-version "/src"))) (:home (expand-file-name "~/src/pkg/emacs/src/emacs-git/src")) (:other nil))) (defun acdw/gc-disable () "Functionally disable the Garbage collector." (setq gc-cons-threshold most-positive-fixnum gc-cons-percentage 0.8)) (defun acdw/gc-enable () "Enable the Garbage collector." (setq gc-cons-threshold (* 800 1024 1024) gc-cons-percentage 0.1)) (defun acdw/insert-iso-date (arg) "Insert the ISO-8601-formatted date, optionally including time (pass ARG)." (interactive "P") (let ((format (if arg "%FT%T%z" "%F"))) (insert (format-time-string format (current-time))))) (defun acdw/kill-a-buffer (&optional prefix) "Kill this buffer, or other buffers, depending on PREFIX. \\[acdw/kill-a-buffer] : Kill CURRENT buffer and window \\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window \\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows Prompt only if there are unsaved changes." (interactive "P") (pcase (or (car prefix) 0) (0 (kill-current-buffer) (unless (one-window-p) (delete-window))) (4 (other-window 1) (kill-current-buffer) (unless (one-window-p) (delete-window))) (16 (mapc 'kill-buffer (delq (current-buffer) (buffer-list))) (delete-other-windows)))) (defun acdw/sunrise-sunset (sunrise-command sunset-command) "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset." (let* ((times-regex (rx (* nonl) (: (any ?s ?S) "unrise") " " (group (repeat 1 2 digit) ":" (repeat 1 2 digit) (: (any ?a ?A ?p ?P) (any ?m ?M))) (* nonl) (: (any ?s ?S) "unset") " " (group (repeat 1 2 digit) ":" (repeat 1 2 digit) (: (any ?a ?A ?p ?P) (any ?m ?M))) (* nonl))) (ss (acdw/supress-messages #'sunrise-sunset)) (_m (string-match times-regex ss)) (sunrise-time (match-string 1 ss)) (sunset-time (match-string 2 ss))) (run-at-time sunrise-time (* 60 60 24) sunrise-command) (run-at-time sunset-time (* 60 60 24) sunset-command) (run-at-time "12:00am" (* 60 60 24) sunset-command))) (defun acdw/supress-messages (oldfn &rest args) ; from pkal "Advice wrapper for suppressing `message'. OLDFN is the wrapped function, that is passed the arguments ARGS." (let ((msg (current-message))) (prog1 (let ((inhibit-message t)) (apply oldfn args)) (when msg (message "%s" msg))))) (defun acdw/setup-fringes () "Set up fringes how I likes 'em." (define-fringe-bitmap 'left-curly-arrow [#b01100000 #b00110000 #b00011000 #b00001100] 4 8 'center) (define-fringe-bitmap 'right-curly-arrow [#b00000011 #b00000110 #b00001100 #b00011000] 4 8 'center) (define-fringe-bitmap 'left-arrow [#b01100000 #b01010000] 2 8 '(top t)) (define-fringe-bitmap 'right-arrow [#b00000011 #b00000101] 2 8 '(top t)) (setq-local indicate-empty-lines nil indicate-buffer-boundaries '((top . right) (bottom . right))) (custom-set-faces '(fringe ((t (:foreground "dim gray")))))) (defun acdw/require-private () "Load \"~/.emacs.d/private.el\". It's called 'require-private' for historical reasons." (load (expand-file-name "private.el" user-emacs-directory) :noerror :nomessage)) ;;; Recentf renaming with dired ;; from ... somewhere. 'rjs', apparently? ;; I'm throwing these here because they look better here than in init.el. ;; Comments are "rjs"'s. ;; Magic advice to rename entries in recentf when moving files in ;; dired. (defun rjs/recentf-rename-notify (oldname newname &rest _args) "Magically rename files from OLDNAME to NEWNAME when moved in `dired'." (if (file-directory-p newname) (rjs/recentf-rename-directory oldname newname) (rjs/recentf-rename-file oldname newname))) (defun rjs/recentf-rename-file (oldname newname) "Rename a file from OLDNAME to NEWNAME in `recentf-list'." (setq recentf-list (mapcar (lambda (name) (if (string-equal name oldname) newname oldname)) recentf-list))) (defun rjs/recentf-rename-directory (oldname newname) "Rename directory from OLDNAME to NEWNAME in `recentf-list'." ;; oldname, newname and all entries of recentf-list should already ;; be absolute and normalised so I think this can just test whether ;; oldname is a prefix of the element. (setq recentf-list (mapcar (lambda (name) (if (string-prefix-p oldname name) (concat newname (substring name (length oldname))) name)) recentf-list))) ;;; Sort setq... ;; https://emacs.stackexchange.com/questions/33039/ (defun sort-setq () "Sort a setq. Must be a defun." (interactive) (save-excursion (save-restriction (let ((sort-end (progn (end-of-defun) (backward-char) (point-marker))) (sort-beg (progn (beginning-of-defun) (re-search-forward "[ \\t]*(" (point-at-eol)) (forward-sexp) (re-search-forward "\\_<" (point-at-eol)) (point-marker)))) (narrow-to-region (1- sort-beg) (1+ sort-end)) (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record))))) (defun sort-setq-next-record () "Sort the next record of a `setq' form." (condition-case nil (progn (forward-sexp 1) (backward-sexp)) ('scan-error (goto-char (point-max))))) (defun sort-setq-end-record () "Sort the end of a `setq' record." (condition-case nil (forward-sexp 2) ('scan-error (goto-char (point-max))))) ;;; Crux tweaks ;; `crux-other-window-or-switch-buffer' doesn't take an argument. (defun acdw/other-window-or-switch-buffer (&optional arg) "Call `other-window' with ARG or switch buffers, depending on window count." (interactive "P") (if (one-window-p) (switch-to-buffer nil) (other-window (or arg 1)))) (defun acdw/other-window-or-switch-buffer-backward () "Do `acdw/other-window-or-switch-buffer', but backward." (interactive) (acdw/other-window-or-switch-buffer -1)) ;;; Auth-sources ;; https://github.com/emacs-circe/circe/wiki/Configuration (defun acdw/fetch-password (&rest params) "Fetch a password from `auth-source' using PARAMS. This function is internal. Use `acdw/make-password-fetcher' instead." (let ((match (car (apply #'auth-source-search params)))) (if match (let ((secret (plist-get match :secret))) (if (functionp secret) (funcall secret) secret)) (message "Password not found for %S" params)))) (defun acdw/make-password-fetcher (&rest params) "Make a function that will call `acdw/fetch-password' with PARAMS." (lambda (&rest _) (apply #'acdw/fetch-password params))) ;;; Paren annoyances (defun acdw/stop-paren-annoyances (&optional buffer) "Locally turn off paren-checking functions in BUFFER." (with-current-buffer (or buffer (current-buffer)) (setq-local blink-matching-paren nil show-paren-mode nil))) ;;; 💩 (defun 💩 (&optional n) "💩 x N." (interactive "p") (let ((n (or n 1))) (while (> n 0) (insert "💩") (setq n (1- n))))) (defun spongebob-case-region (beg end) "Make region, defined by BEG and END, lOoK lIkE tHiS." (interactive "*r") (save-excursion (let (case) (goto-char beg) (while (< (point) end) (if (looking-at "[[:alpha:]]") (if (setq case (not case)) (upcase-region (point) (progn (forward-char 1) (point))) (downcase-region (point) (progn (forward-char 1) (point)))) (forward-char 1)))))) (defun spongebob-case-word (n) "Spongebob-case N words forward, beginning at point, moving over." (interactive "*p") (spongebob-case-region (point) (progn (forward-word n) (point)))) (defun spongebob-case-dwim (arg) "Spongebob-case words in the region if active, else word at point. If ARG exists, it's passed to `spongebob-case-word'." (interactive "*p") (if (use-region-p) (spongebob-case-region (region-beginning) (region-end)) (spongebob-case-word arg))) ;;; Fat finger solutions (defun acdw/fat-finger-exit (&optional prefix) "Delete a frame, or kill Emacs with confirmation. When called with PREFIX, just kill Emacs without confirmation." (interactive "P") (if (or prefix (and (= 1 (length (frame-list))) (yes-or-no-p "This is the last frame! Wanna quit?"))) (kill-emacs) (ignore-errors (delete-frame)))) (defun acdw/disabled-command-function (&optional cmd keys) (let ((cmd (or cmd this-command)) (keys (or keys (this-command-keys)))) ;; this logic stolen from original `disabled-command-function' (if (or (eq (aref keys 0) (if (stringp keys) (aref "\M-x" 0) ?\M-x)) (and (>= (length keys) 2) (eq (aref keys 0) meta-prefix-char) (eq (aref keys 1) ?x))) ;; it's been run as an M-x command, we want to do it (call-interactively cmd) ;; else, tell the user it's disabled. (message (substitute-command-keys (concat "Command `%s' has been disabled. " "Run with \\[execute-extended-command].")) cmd)))) ;;; cribbed ;; https://jao.io/blog/2021-09-08-high-signal-to-noise-emacs-command.html (defun jao-buffer-same-mode (&rest modes) "Pop to a buffer with a mode among MODES, or the current one if not given." (interactive) (let* ((modes (or modes (list major-mode))) (pred (lambda (b) (let ((b (get-buffer (if (consp b) (car b) b)))) (member (buffer-local-value 'major-mode b) modes))))) (pop-to-buffer (read-buffer "Buffer: " nil t pred)))) (provide 'acdw) ;;; acdw.el ends here