From a2657993bad828af6743c68931a0e848bfcdec53 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 21 Nov 2021 23:57:41 -0600 Subject: I DECLARE BANKRUPTCY ... 8 Didn't think to do this till pretty .. written, so here we are. --- lisp/acdw-compat.el | 555 ---------------------------------------------------- 1 file changed, 555 deletions(-) delete mode 100644 lisp/acdw-compat.el (limited to 'lisp/acdw-compat.el') diff --git a/lisp/acdw-compat.el b/lisp/acdw-compat.el deleted file mode 100644 index 3221191..0000000 --- a/lisp/acdw-compat.el +++ /dev/null @@ -1,555 +0,0 @@ -;;; acdw-compat.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: 2021-08-11 -;; 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: - -;; This file contains functions, variables, and other code that might not be in -;; every version of Emacs I use. - -;;; Code: - -;; Convenience macro -(defmacro safely (&rest defines) - "Wrap DEFINES in tests to make sure they're not already defined. -Is it necessary? Who knows!!" - (let (output) - (dolist (form defines) - ;; this is one part where elisp being a lisp-2 bites us... - (push (cond ((memq (car form) - '(;; makes functions - define-global-minor-mode - define-globalized-minor-mode - define-minor-mode - defmacro - defsubst - defun)) - `(unless (fboundp ',(cadr form)) - ,form)) - ((memq (car form) - '(;; makes variables - defcustom - defvar - defvar - defvar-local - defvar-mode-local - defvaralias)) - `(unless (boundp ',(cadr form)) - ,form)) - (t form)) - output)) - `(progn ,@(nreverse output)))) - - -;;; Functions for changing capitalization that Do What I Mean -;; Defined in EMACS/lisp/simple.el -(safely - (defun upcase-dwim (arg) - "Upcase words in the region, if active; if not, upcase word at point. -If the region is active, this function calls `upcase-region'. -Otherwise, it calls `upcase-word', with prefix argument passed to it -to upcase ARG words." - (interactive "*p") - (if (use-region-p) - (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (upcase-word arg))) - - (defun downcase-dwim (arg) - "Downcase words in the region, if active; if not, downcase word at point. -If the region is active, this function calls `downcase-region'. -Otherwise, it calls `downcase-word', with prefix argument passed to it -to downcase ARG words." - (interactive "*p") - (if (use-region-p) - (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (downcase-word arg))) - - (defun capitalize-dwim (arg) - "Capitalize words in the region, if active; if not, capitalize word at point. -If the region is active, this function calls `capitalize-region'. -Otherwise, it calls `capitalize-word', with prefix argument passed to it -to capitalize ARG words." - (interactive "*p") - (if (use-region-p) - (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) - (capitalize-word arg)))) - - -;;; Repeat.el -;; Defined in EMACS/lisp/repeat.el - -(safely - (defcustom repeat-too-dangerous '(kill-this-buffer) - "Commands too dangerous to repeat with \\[repeat]." - :group 'convenience - :type '(repeat function)) - - (defvar repeat-message-function nil - "If non-nil, function used by `repeat' command to say what it's doing. -Message is something like \"Repeating command glorp\". -A value of `ignore' will disable such messages. To customize -display, assign a function that takes one string as an arg and -displays it however you want. -If this variable is nil, the normal `message' function will be -used to display the messages.") - - (defcustom repeat-on-final-keystroke t - "Allow `repeat' to re-execute for repeating lastchar of a key sequence. -If this variable is t, `repeat' determines what key sequence -it was invoked by, extracts the final character of that sequence, and -re-executes as many times as that final character is hit; so for example -if `repeat' is bound to C-x z, typing C-x z z z repeats the previous command -3 times. If this variable is a sequence of characters, then re-execution -only occurs if the final character by which `repeat' was invoked is a -member of that sequence. If this variable is nil, no re-execution occurs." - :group 'convenience - :type '(choice (const :tag "Repeat for all keys" t) - (const :tag "Don't repeat" nil) - (sexp :tag "Repeat for specific keys"))) - - (defvar repeat-num-input-keys-at-repeat -1 - "# key sequences read in Emacs session when `repeat' last invoked.") - - (defsubst repeat-is-really-this-command () - "Return t if this command is happening because user invoked `repeat'. -Usually, when a command is executing, the Emacs builtin variable -`this-command' identifies the command the user invoked. Some commands modify -that variable on the theory they're doing more good than harm; `repeat' does -that, and usually does do more good than harm. However, like all do-gooders, -sometimes `repeat' gets surprising results from its altruism. The value of -this function is always whether the value of `this-command' would've been -'repeat if `repeat' hadn't modified it." - (= repeat-num-input-keys-at-repeat num-input-keys)) - - (defvar repeat-previous-repeated-command nil - "The previous repeated command.") - - (defun repeat (repeat-arg) - "Repeat most recently executed command. -If REPEAT-ARG is non-nil (interactively, with a prefix argument), -supply a prefix argument to that command. Otherwise, give the -command the same prefix argument it was given before, if any. - -If this command is invoked by a multi-character key sequence, it -can then be repeated by repeating the final character of that -sequence. This behavior can be modified by the global variable -`repeat-on-final-keystroke'. - -`repeat' ignores commands bound to input events. Hence the term -\"most recently executed command\" shall be read as \"most -recently executed command not bound to an input event\"." - ;; The most recently executed command could be anything, so surprises could - ;; result if it were re-executed in a context where new dynamically - ;; localized variables were shadowing global variables in a `let' clause in - ;; here. (Remember that GNU Emacs 19 is dynamically localized.) - ;; To avoid that, I tried the `lexical-let' of the Common Lisp extensions, - ;; but that entails a very noticeable performance hit, so instead I use the - ;; "repeat-" prefix, reserved by this package, for *local* variables that - ;; might be visible to re-executed commands, including this function's arg. - (interactive "P") - (when (eq last-repeatable-command 'repeat) - (setq last-repeatable-command repeat-previous-repeated-command)) - (cond - ((null last-repeatable-command) - (error "There is nothing to repeat")) - ((eq last-repeatable-command 'mode-exit) - (error "last-repeatable-command is mode-exit & can't be repeated")) - ((memq last-repeatable-command repeat-too-dangerous) - (error "Command %S too dangerous to repeat automatically" - last-repeatable-command))) - (setq this-command last-repeatable-command - repeat-previous-repeated-command last-repeatable-command - repeat-num-input-keys-at-repeat num-input-keys) - (when (null repeat-arg) - (setq repeat-arg last-prefix-arg)) - ;; Now determine whether to loop on repeated taps of the final character - ;; of the key sequence that invoked repeat. The Emacs global - ;; last-command-event contains the final character now, but may not still - ;; contain it after the previous command is repeated, so the character - ;; needs to be saved. - (let ((repeat-repeat-char - (if (eq repeat-on-final-keystroke t) - last-command-event - ;; Allow only specified final keystrokes. - (car (memq last-command-event - (listify-key-sequence - repeat-on-final-keystroke)))))) - (if (eq last-repeatable-command (caar command-history)) - (let ((repeat-command (car command-history))) - (repeat-message "Repeating %S" repeat-command) - (eval repeat-command)) - (if (null repeat-arg) - (repeat-message "Repeating command %S" last-repeatable-command) - (setq current-prefix-arg repeat-arg) - (repeat-message - "Repeating command %S %S" repeat-arg last-repeatable-command)) - (when (eq last-repeatable-command 'self-insert-command) - ;; We used to use a much more complex code to try and figure out - ;; what key was used to run that self-insert-command: - ;; (if (<= (- num-input-keys - ;; repeat-num-input-keys-at-self-insert) - ;; 1) - ;; repeat-last-self-insert - ;; (let ((range (nth 1 buffer-undo-list))) - ;; (condition-case nil - ;; (setq repeat-last-self-insert - ;; (buffer-substring (car range) - ;; (cdr range))) - ;; (error (error "%s %s %s" ;Danger, Will Robinson! - ;; "repeat can't intuit what you" - ;; "inserted before auto-fill" - ;; "clobbered it, sorry"))))) - (setq last-command-event (char-before))) - (let ((indirect (indirect-function last-repeatable-command))) - (if (or (stringp indirect) - (vectorp indirect)) - ;; Bind last-repeatable-command so that executing the macro does - ;; not alter it. - (let ((last-repeatable-command last-repeatable-command)) - (execute-kbd-macro last-repeatable-command)) - (call-interactively last-repeatable-command)))) - (when repeat-repeat-char - (set-transient-map - (let ((map (make-sparse-keymap))) - (define-key map (vector repeat-repeat-char) - (if (null repeat-message-function) 'repeat - ;; If repeat-message-function is let-bound, preserve it for the - ;; next "iterations of the loop". - (let ((fun repeat-message-function)) - (lambda () - (interactive) - (let ((repeat-message-function fun)) - (setq this-command 'repeat) - ;; Beware: messing with `real-this-command' is *bad*, but we - ;; need it so `last-repeatable-command' can be recognized - ;; later (bug#12232). - (setq real-this-command 'repeat) - (call-interactively 'repeat)))))) - map))))) - - (defun repeat-message (format &rest args) - "Like `message' but displays with `repeat-message-function' if non-nil." - (let ((message (apply 'format format args))) - (if repeat-message-function - (funcall repeat-message-function message) - (message "%s" message)))) - - (defcustom repeat-exit-key nil - "Key that stops the modal repeating of keys in sequence. -For example, you can set it to like `isearch-exit'." - :type '(choice (const :tag "No special key to exit repeating sequence" nil) - (key-sequence :tag "Key that exits repeating sequence")) - :group 'convenience - :version "28.1") - - (defcustom repeat-exit-timeout nil - "Break the repetition chain of keys after specified timeout. -When a number, exit the repeat mode after idle time of the specified -number of seconds." - :type '(choice (const :tag "No timeout to exit repeating sequence" nil) - (number :tag "Timeout in seconds to exit repeating")) - :group 'convenience - :version "28.1") - - (defvar repeat-exit-timer nil - "Timer activated after the last key typed in the repeating key sequence.") - - (defcustom repeat-keep-prefix t - "Keep the prefix arg of the previous command." - :type 'boolean - :group 'convenience - :version "28.1") - - (defcustom repeat-echo-function #'repeat-echo-message - "Function to display a hint about available keys. -Function is called after every repeatable command with one argument: -a repeating map, or nil after deactivating the repeat mode." - :type '(choice (const :tag "Show hints in the echo area" - repeat-echo-message) - (const :tag "Show indicator in the mode line" - repeat-echo-mode-line) - (const :tag "No visual feedback" ignore) - (function :tag "Function")) - :group 'convenience - :version "28.1") - - (defvar repeat-in-progress nil - "Non-nil when the repeating map is active.") - - (defvar repeat-map nil - "The value of the repeating map for the next command. -A command called from the map can set it again to the same map when -the map can't be set on the command symbol property `repeat-map'.") - - (define-minor-mode repeat-mode - "Toggle Repeat mode. -When Repeat mode is enabled, and the command symbol has the property named -`repeat-map', this map is activated temporarily for the next command." - :global t :group 'convenience - (if (not repeat-mode) - (remove-hook 'post-command-hook 'repeat-post-hook) - (add-hook 'post-command-hook 'repeat-post-hook) - (let* ((keymaps nil) - (commands (all-completions - "" obarray (lambda (s) - (and (commandp s) - (get s 'repeat-map) - (push (get s 'repeat-map) keymaps)))))) - (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'." - (length commands) - (length (delete-dups keymaps)))))) - - (defun repeat-post-hook () - "Function run after commands to set transient keymap for repeatable keys." - (let ((was-in-progress repeat-in-progress)) - (setq repeat-in-progress nil) - (when repeat-mode - (let ((rep-map (or repeat-map - (and (symbolp real-this-command) - (get real-this-command 'repeat-map))))) - (when rep-map - (when (boundp rep-map) - (setq rep-map (symbol-value rep-map))) - (let ((map (copy-keymap rep-map))) - - ;; Exit when the last char is not among repeatable keys, - ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. - (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts - (or (lookup-key map (this-command-keys-vector)) - prefix-arg)) - - ;; Messaging - (unless prefix-arg - (funcall repeat-echo-function map)) - - ;; Adding an exit key - (when repeat-exit-key - (define-key map repeat-exit-key 'ignore)) - - (when (and repeat-keep-prefix (not prefix-arg)) - (setq prefix-arg current-prefix-arg)) - - (setq repeat-in-progress t) - (let ((exitfun (set-transient-map map))) - - (when repeat-exit-timer - (cancel-timer repeat-exit-timer) - (setq repeat-exit-timer nil)) - - (when repeat-exit-timeout - (setq repeat-exit-timer - (run-with-idle-timer - repeat-exit-timeout nil - (lambda () - (setq repeat-in-progress nil) - (funcall exitfun) - (funcall repeat-echo-function nil))))))))))) - - (setq repeat-map nil) - (when (and was-in-progress (not repeat-in-progress)) - (when repeat-exit-timer - (cancel-timer repeat-exit-timer) - (setq repeat-exit-timer nil)) - (funcall repeat-echo-function nil)))) - - (defun repeat-echo-message-string (keymap) - "Return a string with a list of repeating keys." - (let (keys) - (map-keymap (lambda (key _) (push key keys)) keymap) - (format-message "Repeat with %s%s" - (mapconcat (lambda (key) - (key-description (vector key))) - keys ", ") - (if repeat-exit-key - (format ", or exit with %s" - (key-description repeat-exit-key)) - "")))) - - (defun repeat-echo-message (keymap) - "Display available repeating keys in the echo area." - (if keymap - (let ((mess (repeat-echo-message-string keymap))) - (if (current-message) - (message "%s [%s]" (current-message) mess) - (message mess))) - (and (current-message) - (string-search "Repeat with " (current-message)) - (message nil)))) - - (defvar repeat-echo-mode-line-string - (propertize "[Repeating...] " 'face 'mode-line-emphasis) - "String displayed in the mode line in repeating mode.") - - (defun repeat-echo-mode-line (keymap) - "Display the repeat indicator in the mode line." - (if keymap - (unless (assq 'repeat-in-progress mode-line-modes) - (add-to-list 'mode-line-modes (list 'repeat-in-progress - repeat-echo-mode-line-string))) - (force-mode-line-update t))) - - (defun describe-repeat-maps () - "Describe mappings of commands repeatable by symbol property `repeat-map'." - (interactive) - (help-setup-xref (list #'describe-repeat-maps) - (called-interactively-p 'interactive)) - (let ((keymaps nil)) - (all-completions - "" obarray (lambda (s) - (and (commandp s) - (get s 'repeat-map) - (push s (alist-get (get s 'repeat-map) keymaps))))) - (with-help-window (help-buffer) - (with-current-buffer standard-output - (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n") - - (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b))))) - (princ (format-message "`%s' keymap is repeatable by these commands:\n" - (car keymap))) - (dolist (command (sort (cdr keymap) 'string-lessp)) - (princ (format-message " `%s'\n" command))) - (princ "\n")))))) - -;;; Bindings! - (defvar undo-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "u" 'undo) - map) - "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.") - (put 'undo 'repeat-map 'undo-repeat-map) - - (defvar next-error-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "n" 'next-error) - (define-key map "\M-n" 'next-error) - (define-key map "p" 'previous-error) - (define-key map "\M-p" 'previous-error) - map) - "Keymap to repeat next-error key sequences. Used in `repeat-mode'.") - (put 'next-error 'repeat-map 'next-error-repeat-map) - (put 'previous-error 'repeat-map 'next-error-repeat-map) - - (defvar page-navigation-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "]" #'forward-page) - (define-key map "[" #'backward-page) - map) - "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") - (put 'forward-page 'repeat-map 'page-navigation-repeat-map) - (put 'backward-page 'repeat-map 'page-navigation-repeat-map) - - (defvar tab-bar-switch-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'tab-next) - (define-key map "O" 'tab-previous) - map) - "Keymap to repeat tab switch key sequences `C-x t o o O'. -Used in `repeat-mode'.") - (put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) - (put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) - - (defvar tab-bar-move-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "m" 'tab-move) - (define-key map "M" (lambda () - (interactive) - (setq repeat-map 'tab-bar-move-repeat-map) - (tab-move -1))) - map) - "Keymap to repeat tab move key sequences `C-x t m m M'. -Used in `repeat-mode'.") - (put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) - - (defvar other-window-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'other-window) - (define-key map "O" (lambda () - (interactive) - (setq repeat-map 'other-window-repeat-map) - (other-window -1))) - map) - "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") - (put 'other-window 'repeat-map 'other-window-repeat-map) - - (defvar resize-window-repeat-map - (let ((map (make-sparse-keymap))) - ;; Standard keys: - (define-key map "^" 'enlarge-window) - (define-key map "}" 'enlarge-window-horizontally) - (define-key map "{" 'shrink-window-horizontally) - ;; Additional keys: - (define-key map "v" 'shrink-window) - map) - "Keymap to repeat window resizing commands. Used in `repeat-mode'.") - (put 'enlarge-window 'repeat-map 'resize-window-repeat-map) - (put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) - (put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) - (put 'shrink-window 'repeat-map 'resize-window-repeat-map) - - (defvar outline-navigation-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-b") #'outline-backward-same-level) - (define-key map (kbd "b") #'outline-backward-same-level) - (define-key map (kbd "C-f") #'outline-forward-same-level) - (define-key map (kbd "f") #'outline-forward-same-level) - (define-key map (kbd "C-n") #'outline-next-visible-heading) - (define-key map (kbd "n") #'outline-next-visible-heading) - (define-key map (kbd "C-p") #'outline-previous-visible-heading) - (define-key map (kbd "p") #'outline-previous-visible-heading) - (define-key map (kbd "C-u") #'outline-up-heading) - (define-key map (kbd "u") #'outline-up-heading) - map)) - - (defvar outline-editing-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-v") #'outline-move-subtree-down) - (define-key map (kbd "v") #'outline-move-subtree-down) - (define-key map (kbd "C-^") #'outline-move-subtree-up) - (define-key map (kbd "^") #'outline-move-subtree-up) - (define-key map (kbd "C->") #'outline-demote) - (define-key map (kbd ">") #'outline-demote) - (define-key map (kbd "C-<") #'outline-promote) - (define-key map (kbd "<") #'outline-promote) - map)) - - (with-eval-after-load 'outline - (dolist (command '(outline-backward-same-level - outline-forward-same-level - outline-next-visible-heading - outline-previous-visible-heading - outline-up-heading)) - (put command 'repeat-map 'outline-navigation-repeat-map)) - - (dolist (command '(outline-move-subtree-down - outline-move-subtree-up - outline-demote - outline-promote)) - (put command 'repeat-map 'outline-editing-repeat-map)))) - - -;;; goto-address-mode -(safely - (defvar global-address-mode nil) - - (define-globalized-minor-mode global-goto-address-mode - goto-address-mode goto-addr-mode--turn-on - :version "28.1") - - (defun goto-addr-mode--turn-on () - (when (not goto-address-mode) - (goto-address-mode 1)))) - -(provide 'acdw-compat) -;;; acdw-compat.el ends here -- cgit 1.4.1-21-gabe81