From: Kim F. Storm <storm@cua.dk>
Date: Tue, 3 Jan 2006 23:35:05 +0000 (+0000)
Subject: (key-sequence): Rework widget to read key binding
X-Git-Tag: emacs-pretest-22.0.90~4907
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0f5642c2e0793b5d52d3c809ac90b4a717e7d190;p=emacs.git

(key-sequence): Rework widget to read key binding
using `kbd' syntax.  Use C-q to insert literal key, event, or code.
(widget-key-sequence-default-value): Default value for empty sequence.
(widget-key-sequence-map): New map for reading key binding.  Bind C-q.
(widget-key-sequence-read-event): New command for C-q.
(widget-key-sequence-validate, widget-key-sequence-value-to-internal)
(widget-key-sequence-value-to-external): New functions.
---

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 1f0b8e746c7..cb55cfb5429 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3161,28 +3161,83 @@ It reads a directory name from an editable text field."
     (widget-apply widget :notify widget event)
     (widget-setup)))
 
+;;; I'm not sure about what this is good for?  KFS.
 (defvar widget-key-sequence-prompt-value-history nil
   "History of input to `widget-key-sequence-prompt-value'.")
 
-;; This mostly works, but I am pretty sure it needs more change
-;; to be 100% correct.  I don't know what the change should be -- rms.
+(defvar widget-key-sequence-default-value [ignore]
+  "Default value for an empty key sequence.")
+
+(defvar widget-key-sequence-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map widget-field-keymap)
+    (define-key map [(control ?q)] 'widget-key-sequence-read-event)
+    map))
 
 (define-widget 'key-sequence 'restricted-sexp
-  "A Lisp function."
+  "A key sequence."
   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
-  :prompt-match 'fboundp
+; :prompt-match 'fboundp   ;; What was this good for?  KFS
   :prompt-history 'widget-key-sequence-prompt-value-history
   :action 'widget-field-action
   :match-alternatives '(stringp vectorp)
-  :validate (lambda (widget)
-	      (unless (or (stringp (widget-value widget))
-			  (vectorp (widget-value widget)))
-		(widget-put widget :error (format "Invalid key sequence: %S"
-						  (widget-value widget)))
-		widget))
-  :value 'ignore
+  :format "%{%t%}: %v"
+  :validate 'widget-key-sequence-validate
+  :value-to-internal 'widget-key-sequence-value-to-internal
+  :value-to-external 'widget-key-sequence-value-to-external
+  :value widget-key-sequence-default-value
+  :keymap widget-key-sequence-map
+  :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
   :tag "Key sequence")
+
+(defun widget-key-sequence-read-event (ev)
+  (interactive (list
+		(let ((inhibit-quit t) quit-flag)
+		  (read-event "Insert KEY, EVENT, or CODE: "))))
+  (let ((ev2 (and (memq 'down (event-modifiers ev))
+		  (read-event)))
+	(tr (and (keymapp function-key-map)
+		 (lookup-key function-key-map (vector ev)))))
+    (when (and (integerp ev)
+	       (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix))))
+		   (and (<= ?a (downcase ev))
+			(< (downcase ev) (+ ?a -10 (min 36 read-quoted-char-radix))))))
+      (setq unread-command-events (cons ev unread-command-events)
+	    ev (read-quoted-char (format "Enter code (radix %d)" read-quoted-char-radix))
+	    tr nil)
+      (if (and (integerp ev) (not (char-valid-p ev)))
+	  (insert (char-to-string ev))))  ;; throw invalid char error
+    (setq ev (key-description (list ev)))
+    (when (arrayp tr)
+      (setq tr (key-description (list (aref tr 0))))
+      (if (y-or-n-p (format "Key %s is translated to %s -- use %s? " ev tr tr))
+	  (setq ev tr ev2 nil)))
+    (insert (if (= (char-before) ?\s)  "" " ") ev " ")
+    (if ev2
+	(insert (key-description (list ev2)) " "))))
+
+(defun widget-key-sequence-validate (widget)
+  (unless (or (stringp (widget-value widget))
+	      (vectorp (widget-value widget)))
+    (widget-put widget :error (format "Invalid key sequence: %S"
+				      (widget-value widget)))
+    widget))
+
+(defun widget-key-sequence-value-to-internal (widget value)
+  (if (widget-apply widget :match value)
+      (if (equal value widget-key-sequence-default-value)
+	  ""
+	(key-description value))
+    value))
+
+(defun widget-key-sequence-value-to-external (widget value)
+  (if (stringp value)
+      (if (string-match "\\`[[:space:]]*\\'" value)
+	  widget-key-sequence-default-value
+	(read-kbd-macro value))
+    value))
+
 
 (define-widget 'sexp 'editable-field
   "An arbitrary Lisp expression."
diff --git a/src/ChangeLog b/src/ChangeLog
index 38d7ca945ce..eed0c4dddb8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2006-01-04  Kim F. Storm  <storm@cua.dk>
+
+	* .gdbinit: Undo last change.  Instead, look at Vsystem_type to
+	determine which breakpoints to set.
+
 2006-01-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* keymap.c (describe_map_compare): Yet another int/Lisp_Object mixup.