From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Kangas Newsgroups: gmane.emacs.devel Subject: Re: Moving kbd to subr.el Date: Thu, 14 Oct 2021 04:33:48 -0700 Message-ID: References: <20211004081724.6281.11798@vcs0.savannah.gnu.org> <20211004081727.4F24921048@vcs0.savannah.gnu.org> <871r4qcs8s.fsf@gnus.org> <87o87ubcnl.fsf@gnus.org> <87h7dm9en7.fsf@gnus.org> <87czoa9e7p.fsf@gnus.org> <878ryxakv9.fsf@gnus.org> <87lf2wkqwl.fsf@igel.home> Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="30494"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Lars Ingebrigtsen , emacs-devel@gnu.org To: Andreas Schwab Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu Oct 14 13:36:13 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1maz1x-0007i0-Ar for ged-emacs-devel@m.gmane-mx.org; Thu, 14 Oct 2021 13:36:13 +0200 Original-Received: from localhost ([::1]:33526 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1maz1w-0003Al-Cu for ged-emacs-devel@m.gmane-mx.org; Thu, 14 Oct 2021 07:36:12 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:36252) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mayzg-0007P0-5D for emacs-devel@gnu.org; Thu, 14 Oct 2021 07:33:52 -0400 Original-Received: from mail-pj1-x102b.google.com ([2607:f8b0:4864:20::102b]:33376) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mayze-0006hG-Dd for emacs-devel@gnu.org; Thu, 14 Oct 2021 07:33:51 -0400 Original-Received: by mail-pj1-x102b.google.com with SMTP id q10-20020a17090a1b0a00b001a076a59640so5388115pjq.0 for ; Thu, 14 Oct 2021 04:33:50 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:in-reply-to:references:mime-version:date:message-id:subject:to :cc; bh=b+us5AQDr0/WWciiNwttdeNnYZ+xV2lxlp+YpgzPB9M=; b=Eifc0Yv65pcunQiMPII0ZvpbL5mNQzan1HEmUrYTaRyXpGzUd2QNwq8r44s1nEpV5f EoCIXRXWLLFs+j21Db94EY6jdk+yyzTp2Th4/Vj0jjRiMjxgjH0W1YK1oi8q7OwSGIRJ U+0rqNWeOhNhn6y6/S9xkEsi7l8ezl254XLDNzzV5k66Ibz/niRIuRncz61q+nr1VNEM ithmCLi/RLDAU7nT1cecS80xSFao5NAwYaE68ETMWwjzdiEPKkjMUpPhE9LULjhqaxfJ 4htAUT+kuaM6SwD02cZYUNESFts3ajzLoZq14uakCsLjhXmgYeoXNrK68xhT34XBqYAy xvPA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:in-reply-to:references:mime-version:date :message-id:subject:to:cc; bh=b+us5AQDr0/WWciiNwttdeNnYZ+xV2lxlp+YpgzPB9M=; b=pb1rq/dVhCkgNF6JK0NUZfx/3x/+MraTpBKrA/+3m1T4TgbhmGgSeVBwMHIVWNh1YP p1p89rzid10JUAfvAqoHcA4kyCDSi9g7slQD+RzPuVl73eCf4VsPFh9uPtnTzuI8s7cz 8H3/1qvpL0wsc29vo29Rr2I0c+fR0QPfF3VcsnjEAxcBjb6WAL6NDTCEdcCeqnPfLo6P 0fzYSS3YBUtJLXXIJib3hfxOSqbWEx1C6ya1DwmguSYOCQ5snuWRY1mb/wLwTFUgmK4S 7szOkPLpMWeAtuunWRQY4DxOp8XiGy0TE+SRqbIN3OnAwmEcOT9wAzuJceilt6FyOaBf u3eA== X-Gm-Message-State: AOAM532nnGR4vmhGYwWX6BcQTgW7JPfO1Y2bT39HX1wtE4o9KnPHwx1j DrE+oCXfWYSd8BTeDp3CTKgJLrV1Zhfif+MamsMB8Xez X-Google-Smtp-Source: ABdhPJwxamPwy9pAwIQJe2iJW0jNkI5Gz7ozI6yYcV6Ig5KGe1dkrG2vnu9RptE4KbjgvCHH/BeLj+JquhJMuy8Qdqs= X-Received: by 2002:a17:90a:460a:: with SMTP id w10mr19829641pjg.132.1634211228777; Thu, 14 Oct 2021 04:33:48 -0700 (PDT) Original-Received: from 753933720722 named unknown by gmailapi.google.com with HTTPREST; Thu, 14 Oct 2021 04:33:48 -0700 In-Reply-To: <87lf2wkqwl.fsf@igel.home> Received-SPF: pass client-ip=2607:f8b0:4864:20::102b; envelope-from=stefankangas@gmail.com; helo=mail-pj1-x102b.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:276991 Archived-At: Andreas Schwab 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 "". >> + (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?