Re: Moving kbd to subr.el

[Stefan Kangas]

Andreas Schwab <schwab@linux-m68k.org> writes:

> On Okt 13 2021, Stefan Kangas wrote:
>
>> +    (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))))))
>> +      (when (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)) ?\)))
>> +        (setq res (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)
>> +                                    lres))))
>> +      (if (let ((ret t))
>> +            (dolist (ch (append res nil))
>> +              (unless (and (characterp ch)
>> +                           (let ((ch2 (logand ch (lognot ?\M-\^@))))
>> +                             (and (>= ch2 0) (<= ch2 127))))
>> +                (setq ret nil)))
>> +            ret)
>> +          (concat (mapcar (lambda (ch)
>> +                            (if (= (logand ch ?\M-\^@) 0)
>> +                                ch (+ ch 128)))
>> +                          (append res nil)))
>> +        res))))
>
> That needs to be factored out.

Sorry, which part are you referring to?  All of the above?