Two out of three ain't bad

1 files changed, 240 insertions, 0 deletions

@@ -0,0 +1,240 @@
+;;; compat.el --- Thin backward-compatibility shim -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; I use different versionso of Emacs.  Sometimes I have to copy-paste functions
+;; from newer Emacs to make my customizations work.  This is that file.
+
+;; This is probably ill-advised.
+
+;;; Code:
+
+(unless (fboundp 'keymap--compile-check)
+  (defun keymap--compile-check (&rest keys)
+    (dolist (key keys)
+      (when (or (vectorp key)
+                (and (stringp key) (not (key-valid-p key))))
+        (byte-compile-warn "Invalid `kbd' syntax: %S" key)))))
+
+(unless (fboundp 'keymap-lookup)
+  (defun keymap-lookup (keymap key &optional accept-default no-remap position)
+    "Return the binding for command KEY.
+KEY is a string that satisfies `key-valid-p'.
+
+If KEYMAP is nil, look up in the current keymaps.  If non-nil, it
+should either be a keymap or a list of keymaps, and only these
+keymap(s) will be consulted.
+
+The binding is probably a symbol with a function definition.
+
+Normally, `keymap-lookup' ignores bindings for t, which act as
+default bindings, used when nothing else in the keymap applies;
+this makes it usable as a general function for probing keymaps.
+However, if the optional second argument ACCEPT-DEFAULT is
+non-nil, `keymap-lookup' does recognize the default bindings,
+just as `read-key-sequence' does.
+
+Like the normal command loop, `keymap-lookup' will remap the
+command resulting from looking up KEY by looking up the command
+in the current keymaps.  However, if the optional third argument
+NO-REMAP is non-nil, `keymap-lookup' returns the unmapped
+command.
+
+If KEY is a key sequence initiated with the mouse, the used keymaps
+will depend on the clicked mouse position with regard to the buffer
+and possible local keymaps on strings.
+
+If the optional argument POSITION is non-nil, it specifies a mouse
+position as returned by `event-start' and `event-end', and the lookup
+occurs in the keymaps associated with it instead of KEY.  It can also
+be a number or marker, in which case the keymap properties at the
+specified buffer position instead of point are used."
+    (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
+    (keymap--check key)
+    (when (and keymap position)
+      (error "Can't pass in both keymap and position"))
+    (if keymap
+        (let ((value (lookup-key keymap (key-parse key) accept-default)))
+          (if (and (not no-remap)
+                   (symbolp value))
+              (or (command-remapping value) value)
+            value))
+      (key-binding (kbd key) accept-default no-remap position))))
+
+(unless (fboundp 'keymap--check)
+  (defun keymap--check (key)
+    "Signal an error if KEY doesn't have a valid syntax."
+    (unless (key-valid-p key)
+      (error "%S is not a valid key definition; see `key-valid-p'" key))))
+
+(unless (fboundp 'key-valid-p)
+  (defun key-valid-p (keys)
+    "Say whether KEYS is a valid key.
+A key is a string consisting of one or more key strokes.
+The key strokes are separated by single space characters.
+
+Each key stroke is either a single character, or the name of an
+event, surrounded by angle brackets.  In addition, any key stroke
+may be preceded by one or more modifier keys.  Finally, a limited
+number of characters have a special shorthand syntax.
+
+Here's some example key sequences.
+
+  \"f\"           (the key 'f')
+  \"S o m\"       (a three key sequence of the keys 'S', 'o' and 'm')
+  \"C-c o\"       (a two key sequence of the keys 'c' with the control modifier
+                 and then the key 'o')
+  \"H-<left>\"    (the key named \"left\" with the hyper modifier)
+  \"M-RET\"       (the \"return\" key with a meta modifier)
+  \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers)
+
+These are the characters that have shorthand syntax:
+NUL, RET, TAB, LFD, ESC, SPC, DEL.
+
+Modifiers have to be specified in this order:
+
+   A-C-H-M-S-s
+
+which is
+
+   Alt-Control-Hyper-Meta-Shift-super"
+    (declare (pure t) (side-effect-free t))
+    (and
+     (stringp keys)
+     (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys)
+     (save-match-data
+       (catch 'exit
+         (let ((prefixes
+                "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")
+               (case-fold-search nil))
+           (dolist (key (split-string keys " "))
+             ;; Every key might have these modifiers, and they should be
+             ;; in this order.
+             (when (string-match (concat "\\`" prefixes) key)
+               (setq key (substring key (match-end 0))))
+             (unless (or (and (= (length key) 1)
+                              ;; Don't accept control characters as keys.
+                              (not (< (aref key 0) ?\s))
+                              ;; Don't accept Meta'd characters as keys.
+                              (or (multibyte-string-p key)
+                                  (not (<= 127 (aref key 0) 255))))
+                         (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key)
+                              ;; Don't allow <M-C-down>.
+                              (= (progn
+                                   (string-match
+                                    (concat "\\`<" prefixes) key)
+                                   (match-end 0))
+                                 1))
+                         (string-match-p
+                          "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'"
+                          key))
+               ;; Invalid.
+               (throw 'exit nil)))
+           t))))))
+
+(unless (fboundp 'key-parse)
+  (defun key-parse (keys)
+    "Convert KEYS to the internal Emacs key representation.
+See `kbd' for a descripion of KEYS."
+    (declare (pure t) (side-effect-free t))
+    ;; A pure function is expected to preserve the match data.
+    (save-match-data
+      (let ((case-fold-search nil)
+            (len (length keys)) ; We won't alter keys in the loop below.
+            (pos 0)
+            (res []))
+        (while (and (< pos len)
+                    (string-match "[^ \t\n\f]+" keys pos))
+          (let* ((word-beg (match-beginning 0))
+                 (word-end (match-end 0))
+                 (word (substring keys word-beg len))
+                 (times 1)
+                 key)
+            ;; Try to catch events of the form "<as df>".
+            (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
+                (setq word (match-string 0 word)
+                      pos (+ word-beg (match-end 0)))
+              (setq word (substring keys word-beg word-end)
+                    pos word-end))
+            (when (string-match "\\([0-9]+\\)\\*." word)
+              (setq times (string-to-number (substring word 0 (match-end 1))))
+              (setq word (substring word (1+ (match-end 1)))))
+            (cond ((string-match "^<<.+>>$" word)
+                   (setq key (vconcat (if (eq (key-binding [?\M-x])
+                                              'execute-extended-command)
+                                          [?\M-x]
+                                        (or (car (where-is-internal
+                                                  'execute-extended-command))
+                                            [?\M-x]))
+                                      (substring word 2 -2) "\r")))
+                  ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
+                        (progn
+                          (setq word (concat (match-string 1 word)
+                                             (match-string 3 word)))
+                          (not (string-match
+                                "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
+                                word))))
+                   (setq key (list (intern word))))
+                  ((or (equal word "REM") (string-match "^;;" word))
+                   (setq pos (string-match "$" keys pos)))
+                  (t
+                   (let ((orig-word word) (prefix 0) (bits 0))
+                     (while (string-match "^[ACHMsS]-." word)
+                       (setq bits (+ bits
+                                     (cdr
+                                      (assq (aref word 0)
+                                            '((?A . ?\A-\^@) (?C . ?\C-\^@)
+                                              (?H . ?\H-\^@) (?M . ?\M-\^@)
+                                              (?s . ?\s-\^@) (?S . ?\S-\^@))))))
+                       (setq prefix (+ prefix 2))
+                       (setq word (substring word 2)))
+                     (when (string-match "^\\^.$" word)
+                       (setq bits (+ bits ?\C-\^@))
+                       (setq prefix (1+ prefix))
+                       (setq word (substring word 1)))
+                     (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
+                                                ("LFD" . "\n") ("TAB" . "\t")
+                                                ("ESC" . "\e") ("SPC" . " ")
+                                                ("DEL" . "\177")))))
+                       (when found (setq word (cdr found))))
+                     (when (string-match "^\\\\[0-7]+$" word)
+                       (let ((n 0))
+                         (dolist (ch (cdr (string-to-list word)))
+                           (setq n (+ (* n 8) ch -48)))
+                         (setq word (vector n))))
+                     (cond ((= bits 0)
+                            (setq key word))
+                           ((and (= bits ?\M-\^@) (stringp word)
+                                 (string-match "^-?[0-9]+$" word))
+                            (setq key (mapcar (lambda (x) (+ x bits))
+                                              (append word nil))))
+                           ((/= (length word) 1)
+                            (error "%s must prefix a single character, not %s"
+                                   (substring orig-word 0 prefix) word))
+                           ((and (/= (logand bits ?\C-\^@) 0) (stringp word)
+                                 ;; We used to accept . and ? here,
+                                 ;; but . is simply wrong,
+                                 ;; and C-? is not used (we use DEL instead).
+                                 (string-match "[@-_a-z]" word))
+                            (setq key (list (+ bits (- ?\C-\^@)
+                                               (logand (aref word 0) 31)))))
+                           (t
+                            (setq key (list (+ bits (aref word 0)))))))))
+            (when key
+              (dolist (_ (number-sequence 1 times))
+                (setq res (vconcat res key))))))
+        (if (and (>= (length res) 4)
+                 (eq (aref res 0) ?\C-x)
+                 (eq (aref res 1) ?\()
+                 (eq (aref res (- (length res) 2)) ?\C-x)
+                 (eq (aref res (- (length res) 1)) ?\)))
+            (apply #'vector (let ((lres (append res nil)))
+                              ;; Remove the first and last two elements.
+                              (setq lres (cdr (cdr lres)))
+                              (nreverse lres)
+                              (setq lres (cdr (cdr lres)))
+                              (nreverse lres)))
+          res)))))
+
+(provide 'compat)
+;;; compat.el ends here