mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity

(face): Derive from symbol widget. Display sample

Browse Source 
of the current face on the fly.
(widget-face-sample-face-get, widget-face-notify): New functions.
(widget-face-value-create): Remove.
This commit is contained in:
David Ponce 2005-04-05 06:40:12 +00:00
parent f1c7de691a
commit 0e73959747
1 changed files with 22 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
lisp/cus-edit.el
View File

@ -3296,65 +3296,37 @@ restoring it to the state of a face that has never been customized."
(defvar widget-face-prompt-value-history nil
"History of input to `widget-face-prompt-value'.")
(define-widget 'face 'restricted-sexp
"A Lisp face name."
(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-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")
(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)))
;;; 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)))
(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.