1 files changed, 240 insertions, 0 deletions
diff --git a/lisp/compat.el b/lisp/compat.el
new file mode 100644
index 0000000..3107a0c
--- /dev/null
+++ b/lisp/compat.el

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

diff --git a/lisp/compat.el b/lisp/compat.el new file mode 100644 index 0000000..3107a0c --- /dev/null +++ b/lisp/compat.el
@@ -0,0 +1,240 @@
	1	;;; compat.el --- Thin backward-compatibility shim -- lexical-binding: t; --
	2
	3	;;; Commentary:
	4
	5	;; I use different versionso of Emacs. Sometimes I have to copy-paste functions
	6	;; from newer Emacs to make my customizations work. This is that file.
	7
	8	;; This is probably ill-advised.
	9
	10	;;; Code:
	11
	12	(unless (fboundp 'keymap--compile-check)
	13	(defun keymap--compile-check (&rest keys)
	14	(dolist (key keys)
	15	(when (or (vectorp key)
	16	(and (stringp key) (not (key-valid-p key))))
	17	(byte-compile-warn "Invalid `kbd' syntax: %S" key)))))
	18
	19	(unless (fboundp 'keymap-lookup)
	20	(defun keymap-lookup (keymap key &optional accept-default no-remap position)
	21	"Return the binding for command KEY.
	22	KEY is a string that satisfies `key-valid-p'.
	23
	24	If KEYMAP is nil, look up in the current keymaps. If non-nil, it
	25	should either be a keymap or a list of keymaps, and only these
	26	keymap(s) will be consulted.
	27
	28	The binding is probably a symbol with a function definition.
	29
	30	Normally, `keymap-lookup' ignores bindings for t, which act as
	31	default bindings, used when nothing else in the keymap applies;
	32	this makes it usable as a general function for probing keymaps.
	33	However, if the optional second argument ACCEPT-DEFAULT is
	34	non-nil, `keymap-lookup' does recognize the default bindings,
	35	just as `read-key-sequence' does.
	36
	37	Like the normal command loop, `keymap-lookup' will remap the
	38	command resulting from looking up KEY by looking up the command
	39	in the current keymaps. However, if the optional third argument
	40	NO-REMAP is non-nil, `keymap-lookup' returns the unmapped
	41	command.
	42
	43	If KEY is a key sequence initiated with the mouse, the used keymaps
	44	will depend on the clicked mouse position with regard to the buffer
	45	and possible local keymaps on strings.
	46
	47	If the optional argument POSITION is non-nil, it specifies a mouse
	48	position as returned by `event-start' and `event-end', and the lookup
	49	occurs in the keymaps associated with it instead of KEY. It can also
	50	be a number or marker, in which case the keymap properties at the
	51	specified buffer position instead of point are used."
	52	(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
	53	(keymap--check key)
	54	(when (and keymap position)
	55	(error "Can't pass in both keymap and position"))
	56	(if keymap
	57	(let ((value (lookup-key keymap (key-parse key) accept-default)))
	58	(if (and (not no-remap)
	59	(symbolp value))
	60	(or (command-remapping value) value)
	61	value))
	62	(key-binding (kbd key) accept-default no-remap position))))
	63
	64	(unless (fboundp 'keymap--check)
	65	(defun keymap--check (key)
	66	"Signal an error if KEY doesn't have a valid syntax."
	67	(unless (key-valid-p key)
	68	(error "%S is not a valid key definition; see `key-valid-p'" key))))
	69
	70	(unless (fboundp 'key-valid-p)
	71	(defun key-valid-p (keys)
	72	"Say whether KEYS is a valid key.
	73	A key is a string consisting of one or more key strokes.
	74	The key strokes are separated by single space characters.
	75
	76	Each key stroke is either a single character, or the name of an
	77	event, surrounded by angle brackets. In addition, any key stroke
	78	may be preceded by one or more modifier keys. Finally, a limited
	79	number of characters have a special shorthand syntax.
	80
	81	Here's some example key sequences.
	82
	83	\"f\" (the key 'f')
	84	\"S o m\" (a three key sequence of the keys 'S', 'o' and 'm')
	85	\"C-c o\" (a two key sequence of the keys 'c' with the control modifier
	86	and then the key 'o')
	87	\"H-<left>\" (the key named \"left\" with the hyper modifier)
	88	\"M-RET\" (the \"return\" key with a meta modifier)
	89	\"C-M-<space>\" (the \"space\" key with both the control and meta modifiers)
	90
	91	These are the characters that have shorthand syntax:
	92	NUL, RET, TAB, LFD, ESC, SPC, DEL.
	93
	94	Modifiers have to be specified in this order:
	95
	96	A-C-H-M-S-s
	97
	98	which is
	99
	100	Alt-Control-Hyper-Meta-Shift-super"
	101	(declare (pure t) (side-effect-free t))
	102	(and
	103	(stringp keys)
	104	(string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys)
	105	(save-match-data
	106	(catch 'exit
	107	(let ((prefixes
	108	"\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")
	109	(case-fold-search nil))
	110	(dolist (key (split-string keys " "))
	111	;; Every key might have these modifiers, and they should be
	112	;; in this order.
	113	(when (string-match (concat "\\`" prefixes) key)
	114	(setq key (substring key (match-end 0))))
	115	(unless (or (and (= (length key) 1)
	116	;; Don't accept control characters as keys.
	117	(not (< (aref key 0) ?\s))
	118	;; Don't accept Meta'd characters as keys.
	119	(or (multibyte-string-p key)
	120	(not (<= 127 (aref key 0) 255))))
	121	(and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key)
	122	;; Don't allow <M-C-down>.
	123	(= (progn
	124	(string-match
	125	(concat "\\`<" prefixes) key)
	126	(match-end 0))
	127	1))
	128	(string-match-p
	129	"\\`\\(NUL\\\|RET\\\|TAB\\\|LFD\\\|ESC\\\|SPC\\\|DEL\\)\\'"
	130	key))
	131	;; Invalid.
	132	(throw 'exit nil)))
	133	t))))))
	134
	135	(unless (fboundp 'key-parse)
	136	(defun key-parse (keys)
	137	"Convert KEYS to the internal Emacs key representation.
	138	See `kbd' for a descripion of KEYS."
	139	(declare (pure t) (side-effect-free t))
	140	;; A pure function is expected to preserve the match data.
	141	(save-match-data
	142	(let ((case-fold-search nil)
	143	(len (length keys)) ; We won't alter keys in the loop below.
	144	(pos 0)
	145	(res []))
	146	(while (and (< pos len)
	147	(string-match "[^ \t\n\f]+" keys pos))
	148	(let* ((word-beg (match-beginning 0))
	149	(word-end (match-end 0))
	150	(word (substring keys word-beg len))
	151	(times 1)
	152	key)
	153	;; Try to catch events of the form "<as df>".
	154	(if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
	155	(setq word (match-string 0 word)
	156	pos (+ word-beg (match-end 0)))
	157	(setq word (substring keys word-beg word-end)
	158	pos word-end))
	159	(when (string-match "\\([0-9]+\\)\\*." word)
	160	(setq times (string-to-number (substring word 0 (match-end 1))))
	161	(setq word (substring word (1+ (match-end 1)))))
	162	(cond ((string-match "^<<.+>>$" word)
	163	(setq key (vconcat (if (eq (key-binding [?\M-x])
	164	'execute-extended-command)
	165	[?\M-x]
	166	(or (car (where-is-internal
	167	'execute-extended-command))
	168	[?\M-x]))
	169	(substring word 2 -2) "\r")))
	170	((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
	171	(progn
	172	(setq word (concat (match-string 1 word)
	173	(match-string 3 word)))
	174	(not (string-match
	175	"\\<\\(NUL\\\|RET\\\|LFD\\\|ESC\\\|SPC\\\|DEL\\)$"
	176	word))))
	177	(setq key (list (intern word))))
	178	((or (equal word "REM") (string-match "^;;" word))
	179	(setq pos (string-match "$" keys pos)))
	180	(t
	181	(let ((orig-word word) (prefix 0) (bits 0))
	182	(while (string-match "^[ACHMsS]-." word)
	183	(setq bits (+ bits
	184	(cdr
	185	(assq (aref word 0)
	186	'((?A . ?\A-\^@) (?C . ?\C-\^@)
	187	(?H . ?\H-\^@) (?M . ?\M-\^@)
	188	(?s . ?\s-\^@) (?S . ?\S-\^@))))))
	189	(setq prefix (+ prefix 2))
	190	(setq word (substring word 2)))
	191	(when (string-match "^\\^.$" word)
	192	(setq bits (+ bits ?\C-\^@))
	193	(setq prefix (1+ prefix))
	194	(setq word (substring word 1)))
	195	(let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
	196	("LFD" . "\n") ("TAB" . "\t")
	197	("ESC" . "\e") ("SPC" . " ")
	198	("DEL" . "\177")))))
	199	(when found (setq word (cdr found))))
	200	(when (string-match "^\\\\[0-7]+$" word)
	201	(let ((n 0))
	202	(dolist (ch (cdr (string-to-list word)))
	203	(setq n (+ (* n 8) ch -48)))
	204	(setq word (vector n))))
	205	(cond ((= bits 0)
	206	(setq key word))
	207	((and (= bits ?\M-\^@) (stringp word)
	208	(string-match "^-?[0-9]+$" word))
	209	(setq key (mapcar (lambda (x) (+ x bits))
	210	(append word nil))))
	211	((/= (length word) 1)
	212	(error "%s must prefix a single character, not %s"
	213	(substring orig-word 0 prefix) word))
	214	((and (/= (logand bits ?\C-\^@) 0) (stringp word)
	215	;; We used to accept . and ? here,
	216	;; but . is simply wrong,
	217	;; and C-? is not used (we use DEL instead).
	218	(string-match "[@-_a-z]" word))
	219	(setq key (list (+ bits (- ?\C-\^@)
	220	(logand (aref word 0) 31)))))
	221	(t
	222	(setq key (list (+ bits (aref word 0)))))))))
	223	(when key
	224	(dolist (_ (number-sequence 1 times))
	225	(setq res (vconcat res key))))))
	226	(if (and (>= (length res) 4)
	227	(eq (aref res 0) ?\C-x)
	228	(eq (aref res 1) ?\()
	229	(eq (aref res (- (length res) 2)) ?\C-x)
	230	(eq (aref res (- (length res) 1)) ?\)))
	231	(apply #'vector (let ((lres (append res nil)))
	232	;; Remove the first and last two elements.
	233	(setq lres (cdr (cdr lres)))
	234	(nreverse lres)
	235	(setq lres (cdr (cdr lres)))
	236	(nreverse lres)))
	237	res)))))
	238
	239	(provide 'compat)
	240	;;; compat.el ends here