From 16604de81858b42701815850a80e2b6651ce0fc2 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 6 Feb 2022 22:14:50 -0600 Subject: Change compat logic --- lisp/compat.el | 229 +-------------------------------------------------------- 1 file changed, 3 insertions(+), 226 deletions(-) (limited to 'lisp/compat.el') diff --git a/lisp/compat.el b/lisp/compat.el index 3107a0c..0cc4c42 100644 --- a/lisp/compat.el +++ b/lisp/compat.el @@ -9,232 +9,9 @@ ;;; 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-\" (the key named \"left\" with the hyper modifier) - \"M-RET\" (the \"return\" key with a meta modifier) - \"C-M-\" (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 . - (= (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 "". - (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))))) +;; Load stuff in compat/ subdirectory +(dolist (file (directory-files (locate-user-emacs-file "lisp/compat") :full "\\.el\\'")) + (load file :noerror)) (provide 'compat) ;;; compat.el ends here -- cgit 1.4.1-21-gabe81