From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Andreas Schwab Newsgroups: gmane.emacs.devel Subject: Re: Moving kbd to subr.el Date: Thu, 14 Oct 2021 09:27:06 +0200 Message-ID: <87lf2wkqwl.fsf@igel.home> 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> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="30810"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) Cc: Lars Ingebrigtsen , emacs-devel@gnu.org To: Stefan Kangas Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu Oct 14 09:28:04 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 1mav9o-0007kj-B5 for ged-emacs-devel@m.gmane-mx.org; Thu, 14 Oct 2021 09:28:04 +0200 Original-Received: from localhost ([::1]:42360 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mav9n-0006sd-8k for ged-emacs-devel@m.gmane-mx.org; Thu, 14 Oct 2021 03:28:03 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:57832) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mav8z-0005m6-IS for emacs-devel@gnu.org; Thu, 14 Oct 2021 03:27:13 -0400 Original-Received: from mail-out.m-online.net ([2001:a60:0:28:0:1:25:1]:37357) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mav8w-0001p2-VK for emacs-devel@gnu.org; Thu, 14 Oct 2021 03:27:13 -0400 Original-Received: from frontend01.mail.m-online.net (unknown [192.168.8.182]) by mail-out.m-online.net (Postfix) with ESMTP id 4HVLZN1MBZz1sGfB; Thu, 14 Oct 2021 09:27:08 +0200 (CEST) Original-Received: from localhost (dynscan1.mnet-online.de [192.168.6.70]) by mail.m-online.net (Postfix) with ESMTP id 4HVLZN13FMz1qqkG; Thu, 14 Oct 2021 09:27:08 +0200 (CEST) X-Virus-Scanned: amavisd-new at mnet-online.de Original-Received: from mail.mnet-online.de ([192.168.8.182]) by localhost (dynscan1.mail.m-online.net [192.168.6.70]) (amavisd-new, port 10024) with ESMTP id GN0GWnLfH5va; Thu, 14 Oct 2021 09:27:07 +0200 (CEST) X-Auth-Info: zZI0azslWLPUG8FvjhEZdTAGLzJjl0gmsxPxoIlhY/EcmD0BXnkq/ntlakp9oN+T Original-Received: from igel.home (ppp-46-244-161-64.dynamic.mnet-online.de [46.244.161.64]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mail.mnet-online.de (Postfix) with ESMTPSA; Thu, 14 Oct 2021 09:27:06 +0200 (CEST) Original-Received: by igel.home (Postfix, from userid 1000) id 5F1742C09D3; Thu, 14 Oct 2021 09:27:06 +0200 (CEST) X-Yow: Thank god!!.. It's HENNY YOUNGMAN!! In-Reply-To: (Stefan Kangas's message of "Wed, 13 Oct 2021 15:28:36 -0700") Received-SPF: pass client-ip=2001:a60:0:28:0:1:25:1; envelope-from=whitebox@nefkom.net; helo=mail-out.m-online.net X-Spam_score_int: -23 X-Spam_score: -2.4 X-Spam_bar: -- X-Spam_report: (-2.4 / 5.0 requ) BAYES_00=-1.9, HEADER_FROM_DIFFERENT_DOMAINS=0.249, RCVD_IN_DNSWL_LOW=-0.7, 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:276972 Archived-At: 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. Andreas. -- Andreas Schwab, schwab@linux-m68k.org GPG Key fingerprint = 7578 EB47 D4E5 4D69 2510 2552 DF73 E780 A9DA AEC1 "And now for something completely different."