From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: "Drew Adams" Newsgroups: gmane.emacs.devel Subject: RE: customizing key definitions with Customize Date: Sat, 17 May 2008 18:22:23 -0700 Message-ID: <003f01c8b885$a0a3ce30$0200a8c0@us.oracle.com> References: <000301c8b39e$ded16a50$0200a8c0@us.oracle.com><003701c8b438$9d6e9f20$0200a8c0@us.oracle.com><87r6c75brc.fsf@jurta.org><87od79sttq.fsf@jurta.org><002701c8b646$afedc3a0$0200a8c0@us.oracle.com> <004301c8b729$b707c120$0200a8c0@us.oracle.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_0040_01C8B84A.F444F630" X-Trace: ger.gmane.org 1211073828 25569 80.91.229.12 (18 May 2008 01:23:48 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 18 May 2008 01:23:48 +0000 (UTC) Cc: emacs-devel@gnu.org To: , "'Juri Linkov'" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun May 18 03:24:24 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JxXdP-0006sZ-Ey for ged-emacs-devel@m.gmane.org; Sun, 18 May 2008 03:24:24 +0200 Original-Received: from localhost ([127.0.0.1]:33110 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JxXce-0008J0-Sr for ged-emacs-devel@m.gmane.org; Sat, 17 May 2008 21:23:36 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JxXca-0008GQ-E5 for emacs-devel@gnu.org; Sat, 17 May 2008 21:23:32 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JxXcZ-0008G9-SO for emacs-devel@gnu.org; Sat, 17 May 2008 21:23:32 -0400 Original-Received: from [199.232.76.173] (port=42887 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JxXcZ-0008G6-PJ for emacs-devel@gnu.org; Sat, 17 May 2008 21:23:31 -0400 Original-Received: from rgminet01.oracle.com ([148.87.113.118]:43683) by monty-python.gnu.org with esmtps (TLS-1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1JxXcT-00067G-Pz; Sat, 17 May 2008 21:23:26 -0400 Original-Received: from rgmgw1.us.oracle.com (rgmgw1.us.oracle.com [138.1.186.110]) by rgminet01.oracle.com (Switch-3.2.4/Switch-3.1.6) with ESMTP id m4I1NNBv015173; Sat, 17 May 2008 19:23:23 -0600 Original-Received: from acsmt351.oracle.com (acsmt351.oracle.com [141.146.40.151]) by rgmgw1.us.oracle.com (Switch-3.2.4/Switch-3.2.4) with ESMTP id m4I139I5002994; Sat, 17 May 2008 19:23:22 -0600 Original-Received: from inet-141-146-46-1.oracle.com by acsmt351.oracle.com with ESMTP id 3674163661211073726; Sat, 17 May 2008 18:22:06 -0700 Original-Received: from dradamslap1 (/24.5.171.3) by bhmail.oracle.com (Oracle Beehive Gateway v4.0) with ESMTP ; Sat, 17 May 2008 18:22:05 -0700 X-Mailer: Microsoft Office Outlook 11 In-Reply-To: <004301c8b729$b707c120$0200a8c0@us.oracle.com> X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.3198 Thread-Index: Aci14WeS7sF2CiUdRxqlv8LezUilIgAYbV7wAC5ICYAAUdn7kA== X-Brightmail-Tracker: AAAAAQAAAAI= X-Brightmail-Tracker: AAAAAQAAAAI= X-Whitelist: TRUE X-Whitelist: TRUE X-detected-kernel: by monty-python.gnu.org: Linux 2.4-2.6 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:97339 Archived-At: This is a multi-part message in MIME format. ------=_NextPart_000_0040_01C8B84A.F444F630 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit > New keymap-option.el attached - please try it out. > > 1. In the implementation I sent previously, the :set function > only did `define-key' for the key definitions (after the user > was done editing them and chose `Set for Session'). That meant > that no previously existing key bindings were removed or changed, > even if the user changed a `Key' value or clicked DEL > to delete the key definition from the option. Only new > bindings were made. > > 2. To remedy that, the :set function needs to first remove > all existing key bindings, so the only bindings will be those > the user has kept. I've done that now, in the attached version. > The :set code now calls `makunbound' and then sets > the keymap variable to (make-sparse-keymap) before it defines > the keys per the user's customizations. That doesn't really do the trick, unfortunately. The keymap itself, not just the keymap variable, needs to be reinitialized and then filled with the new bindings, because the keymap might already have been used as part of other keymaps. In the :set function I had, I've thus replaced (makunbound ',map) and (setq ,map (make-sparse-keymap)) with (when (keymapp ,map) (setcdr ,map nil)). That seems to fix that problem, but there are other problems, listed below. The updated code is attached. 1. Non-sparse keymaps, such as `global-map', can end up with some of their keys undefined after customization. I cobbled together some code that processes key ranges such as "SPC .. ~", in particular to handle the multiple bindings of things like `self-insert-command' in non-sparse keymaps. The attached code raises an error for a non-sparse keymap, but you can comment out the two lines that raise the error (marked "<=== 1"), to try it. 2. However, some maps, such as `global-map', can still end up with some of their keys undefined. You won't want to try `global-map' with error handling #1 turned off. If you want to experiment with `global-map', comment out the line marked "<=== 2". I'm not sure why some key definitions are not reinstated as they should be. Perhaps it has to do with the order of processing the key definitions (e.g. wrt prefix keys). 3. The approach I've used of relying on the output of `substitute-command-keys' does not work completely for menu maps, because it loses the other information besides the real binding (e.g. command). For instance, if this is a menu item: (search-documentation menu-item "Search Documentation" (keymap (emacs-terminology menu-item "Emacs Terminology" search-emacs-glossary (nil) :help "Display the Glossary section of the Emacs manual") ...)) Then the :set function changes that to just this: (search-documentation keymap (emacs-terminology . search-emacs-glossary)) So this is another reason why we should work directly from the keymap, using, say, `map-keymap', and not try to use the output of `substitute-command-keys'. To deal with menus generally, we would need to extend the definion of `key-definition' to accommodate not only the binding (command) but also the other stuff that menu bindings include. A less satisfying alternative would be to just forego being able to customize menu keymaps. The attached code just raises an error if you try to create an option for a menu keymap. 4. There still is an `edmacro-parse-keys' bug that prevents some keys from being handled correctly. With the attached code, the only such key in the global map is, I think, "M-<" - see the separate bug report. Someone more knowledgeable will need to fix `edmacro-parse-keys' the right way. I won't be going any further with this, but I hope someone will. I spent more time on it than I wished, but I hope that some of what I explored might help someone else do things right. I've added some comments in the code, in case it helps. There hasn't been much interest expressed, but I think this would be a good feature if done right. Users can customize the rest of Emacs, besides key bindings, and bindings can be fairly complex to work with. Besides letting users customize bindings generally, such a feature can be used by a library to control (e.g. encourage/discourage) which bindings users customize (with Customize). HTH. ------=_NextPart_000_0040_01C8B84A.F444F630 Content-Type: application/octet-stream; name="keymap-option.el" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="keymap-option.el" (define-widget 'key-definition 'lazy=0A= "Key definition.=0A= A list of two components: KEY, BINDING.=0A= KEY is either a key sequence (string or vector) or a command.=0A= If KEY is a command, then the binding represented is its remapping=0A= to BINDING, which must also be a command."=0A= :tag "Key Definition" :indent 1 :offset 0=0A= :type=0A= '(list=0A= (choice=0A= (key-sequence :tag "Key" :value [ignore])=0A= (restricted-sexp :tag "Command to remap"=0A= :match-alternatives (commandp) :value ignore))=0A= (sexp :tag "Command")))=0A= =0A= (defun custom-create-keymap-option (map)=0A= "Define a user option for keymap MAP."=0A= (interactive=0A= (list (intern (completing-read=0A= "Keymap (symbol): " obarray=0A= (lambda (s) (and (boundp s) (keymapp (symbol-value = s))))=0A= nil nil 'variable-name-history))))=0A= (when (boundp map)=0A= (when (keymap-prompt (symbol-value map))=0A= (error "Cannot create option for a menu keymap"))=0A= (unless (listp (cadr (symbol-value map))) ; = <=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D 1=0A= (error "Cannot create option for a non-sparse keymap"))) ; = <=3D=3D=3D=3D=3D 1=0A= (let ((opt-name (intern (concat (symbol-name map) "-defs")))=0A= (defs ()))=0A= (if (not (and (symbolp map) (boundp map) (keymapp (symbol-value = map))))=0A= (set map (make-sparse-keymap)) ; New map.=0A= =0A= ;; Print key bindings in a temp buffer, wrap each with `kbd', then = read & eval.=0A= (with-temp-buffer=0A= (princ (substitute-command-keys=0A= (concat "\\{" (symbol-name map) "}")) (current-buffer))=0A= (goto-char (point-min))=0A= (with-syntax-table emacs-lisp-mode-syntax-table=0A= (while (re-search-forward=0A= "^key +binding\n\\(-+ +\\)-+\n\n" nil t)=0A= (let ((col (- (match-end 1) (match-beginning 1))))=0A= (while (and (not (eobp)) (not (looking-at "\n\\s-*\n")))=0A= (if (or (eolp) ; Delete these kinds of lines.=0A= (looking-at "^\\S-+.+\\s-+Prefix Command$")=0A= (looking-at ".+(binding currently shadowed)$")=0A= (looking-at "^\\s-+(that binding is currently \=0A= shadowed by another mode)$")=0A= (looking-at "^.+\\s-+[?][?]")) ; This is from a = `lambda'.=0A= (delete-region (line-beginning-position) (1+ = (line-end-position)))=0A= =0A= (end-of-line)=0A= (skip-chars-backward "^ \t\n")=0A= (looking-at "\\(\\sw\\|\\s_\\)+$") ; Cmd name or last = part of key.=0A= (if (>=3D (current-column) col)=0A= (let ((sym (intern-soft (match-string 0)))=0A= (cmd-beg (match-beginning 0))=0A= eokey-pos)=0A= (cond ((or (fboundp sym) ; Command or = pseudo-command.=0A= (memq sym '(mouse-face ignore-event = prev-buffer)))=0A= (end-of-line)=0A= (insert ")")=0A= (goto-char cmd-beg)=0A= (skip-chars-backward " \t")=0A= (setq eokey-pos (point))=0A= (insert "\")") ; +2=0A= (forward-line 0)=0A= (cond ((looking-at=0A= (concat "^\\(\\S-.*\\) \\.\\. = \\(.+\\)\")\\s-+"=0A= (symbol-name sym)))=0A= (let ((key1 (match-string 1))=0A= (key2 (match-string 2)))=0A= (do-key-range sym (key-to-char = key1)=0A= (key-to-char = key2))))=0A= (t=0A= (insert "(,(kbd \"") ; +8=0A= (while (< (point) (+ 8 eokey-pos))=0A= (when (looking-at = "\\(\"\\|\\\\\\)")=0A= (insert "\\"))=0A= (forward-char))=0A= (goto-char (+ 10 cmd-beg))=0A= (forward-line))))=0A= (t ; Not a command. Last part of = key name.=0A= ;; E.g., this might be "Portuguese>" in = key description=0A= ;; = =0A= ;; =0A= (forward-line)=0A= (if (looking-at "^\\s-+\\S-+$")=0A= (custom-create-keymap-option-1 col)=0A= (beginning-of-line)=0A= (delete-region (line-beginning-position)=0A= (1+ = (line-end-position)))))))=0A= (forward-line)=0A= (if (looking-at "^\\s-+\\S-+$")=0A= (custom-create-keymap-option-1 col)=0A= (forward-line -1)=0A= (delete-region (line-beginning-position)=0A= (1+ (line-end-position 2))))))))))=0A= (goto-char (point-min))=0A= (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" nil = t)=0A= (forward-line -3)=0A= (delete-region (line-beginning-position) (1+ = (line-end-position 3))))=0A= (insert "`(\n") (goto-char (point-max)) (insert ")") ; Wrap all = bindings.=0A= (goto-char (point-min))=0A= (setq defs (eval (read (current-buffer)))))) ; Create list of = key-definitions.=0A= =0A= (eval=0A= `(defcustom ,opt-name=0A= ',defs=0A= ,(format "Customizable keymap for `%s'." map)=0A= :type '(repeat key-definition)=0A= :set #'(lambda (sym defns)=0A= (custom-set-default sym defns)=0A= ;; Wipe out the keymap, so user deletions and = replacements will=0A= ;; take effect.=0A= ;; If you try using `global-map', comment out this line = first.=0A= (when (keymapp ,map) (setcdr ,map nil)) ; = <=3D=3D=3D=3D=3D=3D=3D=3D=3D 2=0A= (let (key command)=0A= (dolist (key-def defns)=0A= (setq key (car key-def)=0A= command (cadr key-def))=0A= (if (symbolp key)=0A= (define-key ,map (vector 'remap key) command)=0A= (define-key ,map key command)))))=0A= :initialize #'custom-initialize-set))))=0A= =0A= (defun custom-create-keymap-option-1 (col)=0A= (end-of-line)=0A= (skip-chars-backward "^ \t\n")=0A= (when (looking-at "\\(\\sw\\|\\s_\\)+$")=0A= (if (>=3D (current-column) col)=0A= (let ((sym (intern-soft (match-string 0))))=0A= (cond ((or (fboundp sym)=0A= (memq sym '(mouse-face ignore-event)))=0A= (end-of-line)=0A= (insert ")")=0A= (forward-line -1)=0A= (end-of-line)=0A= (insert "\")") ; +2=0A= (forward-line 0)=0A= (insert "(,(kbd \"") ; +8=0A= (forward-line 2))=0A= (t=0A= (forward-line 0)=0A= (delete-region (line-beginning-position)=0A= (1+ (line-end-position 2)))))))))=0A= =0A= ;; These three functions are used to convert a range of keys such as = "SPC .. ~"=0A= ;; to a sequence of kbd entries that can be read to create bindings.=0A= =0A= (defun do-key-range (symb ch1 ch2)=0A= "Create kbd entries for the keys (characters) CH1 through CH2."=0A= (delete-region (line-beginning-position) (1+ (line-end-position)))=0A= (while (<=3D ch1 ch2)=0A= (insert "(,(kbd \"" (char-to-key-string ch1) "\") " (symbol-name = symb) ")\n")=0A= (setq ch1 (1+ ch1))))=0A= =0A= (defun char-to-key-string (char)=0A= "Return string representation of character CHAR."=0A= (let ((strg (char-to-string char)))=0A= (cond ((eq char ?\ ) (setq strg "SPC"))=0A= ((eq char ?\") (setq strg "\\\""))=0A= ((eq char ?\\) (setq strg "\\\\")))=0A= strg))=0A= =0A= (defun key-to-char (key)=0A= "Convert key representation to character."=0A= (let ((ekey (edmacro-parse-keys key)))=0A= (if (vectorp ekey) (aref ekey 0) (string-to-char ekey))))=0A= =0A= ;; Tried to fix this so that it would correctly handle key descriptions = such as this:=0A= ;; " "=0A= ;; But the substituted regexp breaks the correct handling of "M-x <". = Needs work.=0A= (defun edmacro-parse-keys (string &optional need-vector)=0A= (let ((case-fold-search nil)=0A= (pos 0)=0A= (res []))=0A= (while (and (< pos (length string))=0A= ;; This is the only change I made. Each of these doesn't = work for=0A= ;; some cases, however - Emacs bug filed.=0A= ;; ORIGINAL: (string-match "[^ \t\n\f]+" string pos)=0A= ;; DK suggestion: (string-match "[^ \t\n\f<]+\\|<[^>]+>" string pos))=0A= (string-match "[^ \t\n\f<]+\\|<[^>]+>\\|<+" string pos))=0A= (let ((word (substring string (match-beginning 0) (match-end 0)))=0A= (key nil)=0A= (times 1))=0A= (setq pos (match-end 0))=0A= (when (string-match "\\([0-9]+\\)\\*." word)=0A= (setq times (string-to-number (substring word 0 (match-end 1))))=0A= (setq word (substring word (1+ (match-end 1)))))=0A= (cond ((string-match "^<<.+>>$" word)=0A= (setq key (vconcat (if (eq (key-binding [?\M-x])=0A= 'execute-extended-command)=0A= [?\M-x]=0A= (or (car (where-is-internal=0A= 'execute-extended-command))=0A= [?\M-x]))=0A= (substring word 2 -2) "\r")))=0A= ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)=0A= (progn=0A= (setq word (concat (substring word (match-beginning 1)=0A= (match-end 1))=0A= (substring word (match-beginning 3)=0A= (match-end 3))))=0A= (not (string-match=0A= "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"=0A= word))))=0A= (setq key (list (intern word))))=0A= ((or (equal word "REM") (string-match "^;;" word))=0A= (setq pos (string-match "$" string pos)))=0A= (t=0A= (let ((orig-word word) (prefix 0) (bits 0))=0A= (while (string-match "^[ACHMsS]-." word)=0A= (incf bits (cdr (assq (aref word 0)=0A= '((?A . ?\A-\^@) (?C . ?\C-\^@)=0A= (?H . ?\H-\^@) (?M . ?\M-\^@)=0A= (?s . ?\s-\^@) (?S . ?\S-\^@)))))=0A= (incf prefix 2)=0A= (callf substring word 2))=0A= (when (string-match "^\\^.$" word)=0A= (incf bits ?\C-\^@)=0A= (incf prefix)=0A= (callf substring word 1))=0A= (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")=0A= ("LFD" . "\n") ("TAB" . "\t")=0A= ("ESC" . "\e") ("SPC" . " ")=0A= ("DEL" . "\177")))))=0A= (when found (setq word (cdr found))))=0A= (when (string-match "^\\\\[0-7]+$" word)=0A= (loop for ch across word=0A= for n =3D 0 then (+ (* n 8) ch -48)=0A= finally do (setq word (vector n))))=0A= (cond ((=3D bits 0)=0A= (setq key word))=0A= ((and (=3D bits ?\M-\^@) (stringp word)=0A= (string-match "^-?[0-9]+$" word))=0A= (setq key (loop for x across word collect (+ x bits))))=0A= ((/=3D (length word) 1)=0A= (error "%s must prefix a single character, not %s"=0A= (substring orig-word 0 prefix) word))=0A= ((and (/=3D (logand bits ?\C-\^@) 0) (stringp word)=0A= ;; We used to accept . and ? here,=0A= ;; but . is simply wrong,=0A= ;; and C-? is not used (we use DEL instead).=0A= (string-match "[@-_a-z]" word))=0A= (setq key (list (+ bits (- ?\C-\^@)=0A= (logand (aref word 0) 31)))))=0A= (t=0A= (setq key (list (+ bits (aref word 0)))))))))=0A= (when key=0A= (loop repeat times do (callf vconcat res key)))))=0A= (when (and (>=3D (length res) 4)=0A= (eq (aref res 0) ?\C-x)=0A= (eq (aref res 1) ?\()=0A= (eq (aref res (- (length res) 2)) ?\C-x)=0A= (eq (aref res (- (length res) 1)) ?\)))=0A= (setq res (edmacro-subseq res 2 -2)))=0A= (if (and (not need-vector)=0A= (loop for ch across res=0A= always (and (if (fboundp 'characterp)=0A= (characterp ch) ; Emacs 23+=0A= (char-valid-p ch)) ; Emacs < 23=0A= (let ((ch2 (logand ch (lognot ?\M-\^@))))=0A= (and (>=3D ch2 0) (<=3D ch2 127))))))=0A= (concat (loop for ch across res=0A= collect (if (=3D (logand ch ?\M-\^@) 0)=0A= ch (+ ch 128))))=0A= res)))=0A= ------=_NextPart_000_0040_01C8B84A.F444F630--