comparison lisp/wid-edit.el @ 68005:3d987bde3a79

(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.

68004:1a9ccbce1b6e

	  t)))
    (widget-value-set widget answer)
    (widget-apply widget :notify widget event)
    (widget-setup)))

(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.

(define-widget 'key-sequence 'restricted-sexp
  "A Lisp function."
  :prompt-value 'widget-field-prompt-value
  :prompt-internal 'widget-symbol-prompt-internal
  :prompt-match 'fboundp
  :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
  :tag "Key sequence")

(define-widget 'sexp 'editable-field
  "An arbitrary Lisp expression."
  :tag "Lisp expression"
  :format "%{%t%}: %v"

68005:3d987bde3a79

	  t)))
    (widget-value-set widget answer)
    (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'.")

(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 key sequence."
  :prompt-value 'widget-field-prompt-value
  :prompt-internal 'widget-symbol-prompt-internal
; :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)
  :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."
  :tag "Lisp expression"
  :format "%{%t%}: %v"