comparison lisp/cus-edit.el @ 61307:0592ebb75598

(face): Derive from symbol widget. Display sample of the current face on the fly. (widget-face-sample-face-get, widget-face-notify): New functions. (widget-face-value-create): Remove.

61306:497964065ff1

;;; The `face' Widget.

(defvar widget-face-prompt-value-history nil
  "History of input to `widget-face-prompt-value'.")

(define-widget 'face 'restricted-sexp
  "A Lisp face name."
  :complete-function (lambda ()
		       (interactive)
		       (lisp-complete-symbol 'facep))
  :prompt-value 'widget-field-prompt-value
  :prompt-internal 'widget-symbol-prompt-internal
  :prompt-match 'facep
  :prompt-history 'widget-face-prompt-value-history
  :value-create 'widget-face-value-create
  :action 'widget-field-action
  :match-alternatives '(facep)
  :validate (lambda (widget)
	      (unless (facep (widget-value widget))
		(widget-put widget :error (format "Invalid face: %S"
						  (widget-value widget)))
		widget))
  :value 'ignore
  :tag "Function")


;;; There is a bug here: the sample doesn't get redisplayed
;;; in the new font when you specify one.  Does anyone know how to
;;; make that work?  -- rms.

(defun widget-face-value-create (widget)
  "Create an editable face name field."
  (let ((buttons (widget-get widget :buttons))
	(symbol (widget-get widget :value)))
    ;; Sample.
    (push (widget-create-child-and-convert widget 'item
					   :format "(%{%t%})"
					   :sample-face symbol
					   :tag "sample")
	  buttons)
    (insert " ")
    ;; Update buttons.
    (widget-put widget :buttons buttons))

  (let ((size (widget-get widget :size))
	(value (widget-get widget :value))
	(from (point))
	;; This is changed to a real overlay in `widget-setup'.  We
	;; need the end points to behave differently until
	;; `widget-setup' is called.
	(overlay (cons (make-marker) (make-marker))))
    (widget-put widget :field-overlay overlay)
    (insert value)
    (and size
	 (< (length value) size)
	 (insert-char ?\  (- size (length value))))
    (unless (memq widget widget-field-list)
      (setq widget-field-new (cons widget widget-field-new)))
    (move-marker (cdr overlay) (point))
    (set-marker-insertion-type (cdr overlay) nil)
    (when (null size)
      (insert ?\n))
    (move-marker (car overlay) from)
    (set-marker-insertion-type (car overlay) t)))


;;; The `hook' Widget.

(define-widget 'hook 'list

61307:0592ebb75598

;;; The `face' Widget.

(defvar widget-face-prompt-value-history nil
  "History of input to `widget-face-prompt-value'.")

(define-widget 'face 'symbol
  "A Lisp face name (with sample)."
  :format "%t: (%{sample%}) %v"
  :tag "Face"
  :value 'default
  :sample-face-get 'widget-face-sample-face-get
  :notify 'widget-face-notify
  :match (lambda (widget value) (facep value))
  :complete-function (lambda ()
		       (interactive)
		       (lisp-complete-symbol 'facep))
  :prompt-match 'facep
  :prompt-history 'widget-face-prompt-value-history
  :validate (lambda (widget)
	      (unless (facep (widget-value widget))
		(widget-put widget
			    :error (format "Invalid face: %S"
					   (widget-value widget)))
		widget)))

(defun widget-face-sample-face-get (widget)
  (let ((value (widget-value widget)))
    (if (facep value)
	value
      'default)))

(defun widget-face-notify (widget child &optional event)
  "Update the sample, and notify the parent."
  (overlay-put (widget-get widget :sample-overlay)
	       'face (widget-apply widget :sample-face-get))
  (widget-default-notify widget child event))


;;; The `hook' Widget.

(define-widget 'hook 'list