1 files changed, 0 insertions, 555 deletions

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