Commit 61328d7c authored by Chong Yidong's avatar Chong Yidong
Browse files

Improvements to face customization interface.

* lisp/cus-edit.el (custom-variable, custom-face): Doc fix.
(custom-face-edit): Add value-create attribute.
(custom-face-edit-value-create)
(custom-face-edit-value-visibility-action): New functions.  Hide
unused face attributes by default, and add a visibility toggle.
(custom-face-edit-deactivate): Show empty values with shadow face.
(custom-face-selected): Only use this for face specs with default
attributes.
(custom-face-value-create): Cleanup.

* lisp/wid-edit.el (widget-checklist-value-create): Use dolist.
(widget-checklist-match-find): Make second arg optional.
parent 3d319c8f
2010-10-07 Chong Yidong <cyd@stupidchicken.com>
* cus-edit.el (custom-variable, custom-face): Doc fix.
(custom-face-edit): Add value-create attribute.
(custom-face-edit-value-create)
(custom-face-edit-value-visibility-action): New functions. Hide
unused face attributes by default, and add a visibility toggle.
(custom-face-edit-deactivate): Show empty values with shadow face.
(custom-face-selected): Only use this for face specs with default
attributes.
(custom-face-value-create): Cleanup.
* wid-edit.el (widget-checklist-value-create): Use dolist.
(widget-checklist-match-find): Make second arg optional.
2010-10-07 Glenn Morris <rgm@gnu.org>
 
* hilit-chg.el (hilit-chg-get-diff-info, hilit-chg-get-diff-list-hk):
......
......@@ -1914,7 +1914,7 @@ something in this group has been edited but not set.")
SET for current session only." "\
something in this group has been set but not saved.")
(changed ":" custom-changed "\
CHANGED outside Customize; operating on it here may be unreliable." "\
CHANGED outside Customize." "\
something in this group has been changed outside customize.")
(saved "!" custom-saved "\
SAVED and set." "\
......@@ -2456,16 +2456,22 @@ However, setting it through Custom sets the default value.")
(define-widget 'custom-variable 'custom
"A widget for displaying a Custom variable.
The following property has a special meaning for this widget:
:hidden-states - A list of widget states for which the widget's initial
contents should be hidden."
The following properties have special meanings for this widget:
:hidden-states should be a list of widget states for which the
widget's initial contents are to be hidden.
:custom-form should be a symbol describing how to display and
edit the variable---either `edit' (using edit widgets),
`lisp' (as a Lisp sexp), or `mismatch' (should not happen);
if nil, use the return value of `custom-variable-default-form'."
:format "%v"
:help-echo "Set or reset this variable."
:documentation-property #'custom-variable-documentation
:custom-category 'option
:custom-state nil
:custom-menu 'custom-variable-menu-create
:custom-form nil ; defaults to value of `custom-variable-default-form'
:custom-form nil
:value-create 'custom-variable-value-create
:action 'custom-variable-action
:hidden-states '(standard)
......@@ -3026,24 +3032,64 @@ to switch between two values."
;;; The `custom-face-edit' Widget.
(define-widget 'custom-face-edit 'checklist
"Edit face attributes."
:format "%t: %v"
:tag "Attributes"
:extra-offset 13
"Widget for editing face attributes."
:format "%v"
:extra-offset 3
:button-args '(:help-echo "Control whether this attribute has any effect.")
:value-to-internal 'custom-face-edit-fix-value
:match (lambda (widget value)
(widget-checklist-match widget
(custom-face-edit-fix-value widget value)))
:value-create 'custom-face-edit-value-create
:convert-widget 'custom-face-edit-convert-widget
:args (mapcar (lambda (att)
(list 'group
:inline t
(list 'group :inline t
:sibling-args (widget-get (nth 1 att) :sibling-args)
(list 'const :format "" :value (nth 0 att))
(nth 1 att)))
custom-face-attributes))
(defun custom-face-edit-value-create (widget)
(let* ((value (widget-get widget :value)) ; list of key-value pairs
(alist (widget-checklist-match-find widget value))
(args (widget-get widget :args))
(show-all (widget-get widget :show-all-attributes))
(buttons (widget-get widget :buttons))
entry)
(unless (looking-back "^ *")
(insert ?\n))
(insert-char ?\s (widget-get widget :extra-offset))
(if (or alist show-all)
(dolist (prop args)
(setq entry (assq prop alist))
(if (or entry show-all)
(widget-checklist-add-item widget prop entry)))
(insert (propertize "-- Empty face --" 'face 'shadow) ?\n))
(let ((indent (widget-get widget :indent)))
(if indent (insert-char ?\s (widget-get widget :indent))))
(push (widget-create-child-and-convert
widget 'visibility
:help-echo "Show or hide all face attributes."
:button-face 'custom-visibility
:pressed-face 'custom-visibility
:mouse-face 'highlight
:on "Hide Unused Attributes" :off "Show All Attributes"
:on-image nil :off-image nil
:always-active t
:action 'custom-face-edit-value-visibility-action
show-all)
buttons)
(insert ?\n)
(widget-put widget :buttons buttons)
(widget-put widget :children (nreverse (widget-get widget :children)))))
(defun custom-face-edit-value-visibility-action (widget &rest ignore)
;; Toggle hiding of face attributes.
(let ((parent (widget-get widget :parent)))
(widget-put parent :show-all-attributes
(not (widget-get parent :show-all-attributes)))
(custom-redraw parent)))
(defun custom-face-edit-fix-value (widget value)
"Ignoring WIDGET, convert :bold and :italic in VALUE to new form.
Also change :reverse-video to :inverse-video."
......@@ -3092,7 +3138,7 @@ Also change :reverse-video to :inverse-video."
(save-excursion
(goto-char from)
(widget-default-delete widget)
(insert tag ": *\n")
(insert tag ": " (propertize "--" 'face 'shadow) "\n")
(widget-put widget :inactive
(cons value (cons from (- (point) from))))))))
......@@ -3235,14 +3281,23 @@ Only match frames that support the specified face attributes.")
:version "20.3")
(define-widget 'custom-face 'custom
"Customize face."
"Widget for customizing a face.
The widget value is the face name (a symbol).
The following properties have special meanings for this widget:
:custom-form should be a symbol describing how to display and
edit the face attributes---either `selected' (attributes for
selected display only), `all' (all attributes), `lisp' (as a
Lisp sexp), or `mismatch' (should not happen); if nil, use
the return value of `custom-face-default-form'."
:sample-face 'custom-face-tag
:help-echo "Set or reset this face."
:documentation-property #'face-doc-string
:value-create 'custom-face-value-create
:action 'custom-face-action
:custom-category 'face
:custom-form nil ; defaults to value of `custom-face-default-form'
:custom-form nil
:custom-set 'custom-face-set
:custom-mark-to-save 'custom-face-mark-to-save
:custom-reset-current 'custom-redraw
......@@ -3273,30 +3328,16 @@ Only match frames that support the specified face attributes.")
(not (face-spec-set-match-display value (selected-frame))))
(define-widget 'custom-face-selected 'group
"Edit the attributes of the selected display in a face specification."
:args '((choice :inline t
(group :tag "With Defaults" :inline t
(group (const :tag "" default)
(custom-face-edit :tag " Default\n Attributes"))
(repeat :format ""
:inline t
(group custom-display-unselected sexp))
(group (sexp :format "")
(custom-face-edit :tag " Overriding\n Attributes"))
(repeat :format ""
:inline t
sexp))
(group :tag "No Defaults" :inline t
(repeat :format ""
:inline t
(group custom-display-unselected sexp))
(group (sexp :format "")
(custom-face-edit :tag "\n Attributes"))
(repeat :format ""
:inline t
sexp)))))
"Widget for editing the attributes of a face on the selected display."
:args '((group :tag "No Defaults" :inline t
(repeat :format ""
:inline t
(group custom-display-unselected sexp))
(group (sexp :format "")
(custom-face-edit :tag "\n Attributes"))
(repeat :format ""
:inline t
sexp))))
(defconst custom-face-selected (widget-convert 'custom-face-selected)
"Converted version of the `custom-face-selected' widget.")
......@@ -3344,120 +3385,114 @@ SPEC must be a full face spec."
(defun custom-face-value-create (widget)
"Create a list of the display specifications for WIDGET."
(let ((buttons (widget-get widget :buttons))
children
(symbol (widget-get widget :value))
(tag (widget-get widget :tag))
(state (widget-get widget :custom-state))
(begin (point))
(is-last (widget-get widget :custom-last))
(prefix (widget-get widget :custom-prefix)))
(unless tag
(setq tag (prin1-to-string symbol)))
(cond ((eq custom-buffer-style 'tree)
(insert prefix (if is-last " `--- " " |--- "))
(push (widget-create-child-and-convert
widget 'custom-browse-face-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
(t
;; Visibility.
(push (widget-create-child-and-convert
widget 'custom-visibility
:help-echo "Hide or show this face."
:on "Hide"
:off "Show"
:on-image "down"
:off-image "right"
:action 'custom-toggle-parent
(not (eq state 'hidden)))
buttons)
(insert " ")
;; Create tag.
(insert tag)
(widget-specify-sample widget begin (point))
(if (eq custom-buffer-style 'face)
(insert " ")
(if (string-match "face\\'" tag)
(insert ":")
(insert " face: ")))
;; Sample.
(push (widget-create-child-and-convert widget 'item
:format "(%{%t%})"
:sample-face symbol
:tag "sample")
buttons)
;; Magic.
(insert "\n")
(let ((magic (widget-create-child-and-convert
widget 'custom-magic nil)))
(widget-put widget :custom-magic magic)
(push magic buttons))
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
(widget-put widget :documentation-indent 3)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
;; The comment field
(unless (eq state 'hidden)
(let* ((comment (get symbol 'face-comment))
(comment-widget
(widget-create-child-and-convert
widget 'custom-comment
:parent widget
:value (or comment ""))))
(widget-put widget :comment-widget comment-widget)
(push comment-widget children)))
;; See also.
(unless (eq state 'hidden)
(when (eq (widget-get widget :custom-level) 1)
(custom-add-parent-links widget))
(custom-add-see-also widget))
;; Editor.
(unless (eq (preceding-char) ?\n)
(insert "\n"))
(unless (eq state 'hidden)
(message "Creating face editor...")
(custom-load-widget widget)
(unless (widget-get widget :custom-form)
(widget-put widget :custom-form custom-face-default-form))
(let* ((symbol (widget-value widget))
(spec (or (get symbol 'customized-face)
(get symbol 'saved-face)
(get symbol 'face-defface-spec)
;; Attempt to construct it.
(list (list t (custom-face-attributes-get
symbol (selected-frame))))))
(form (widget-get widget :custom-form))
(indent (widget-get widget :indent))
edit)
;; If the user has changed this face in some other way,
;; edit it as the user has specified it.
(if (not (face-spec-match-p symbol spec (selected-frame)))
(setq spec (list (list t (face-attr-construct symbol (selected-frame))))))
(setq spec (custom-pre-filter-face-spec spec))
(setq edit (widget-create-child-and-convert
widget
(cond ((and (eq form 'selected)
(widget-apply custom-face-selected
:match spec))
(when indent (insert-char ?\ indent))
'custom-face-selected)
((and (not (eq form 'lisp))
(widget-apply custom-face-all
:match spec))
'custom-face-all)
(t
(when indent (insert-char ?\ indent))
'sexp))
:value spec))
(custom-face-state-set widget)
(push edit children)
(widget-put widget :children children))
(message "Creating face editor...done"))))))
(let* ((buttons (widget-get widget :buttons))
(symbol (widget-get widget :value))
(tag (or (widget-get widget :tag)
(prin1-to-string symbol)))
(hiddenp (eq (widget-get widget :custom-state) 'hidden))
children)
(if (eq custom-buffer-style 'tree)
;; Draw a tree-style `custom-face' widget
(progn
(insert (widget-get widget :custom-prefix)
(if (widget-get widget :custom-last) " `--- " " |--- "))
(push (widget-create-child-and-convert
widget 'custom-browse-face-tag)
buttons)
(insert " " tag "\n")
(widget-put widget :buttons buttons))
;; Draw an ordinary `custom-face' widget
(let ((opoint (point)))
;; Visibility indicator.
(push (widget-create-child-and-convert
widget 'custom-visibility
:help-echo "Hide or show this face."
:on "Hide" :off "Show"
:on-image "down" :off-image "right"
:action 'custom-toggle-parent
(not hiddenp))
buttons)
;; Face name (tag).
(insert " " tag)
(widget-specify-sample widget opoint (point)))
(insert
(cond ((eq custom-buffer-style 'face) " ")
((string-match "face\\'" tag) ":")
(t " face: ")))
;; Face sample.
(push (widget-create-child-and-convert
widget 'item
:format "(%{%t%})" :sample-face symbol :tag "sample")
buttons)
;; Magic.
(insert "\n")
(let ((magic (widget-create-child-and-convert
widget 'custom-magic nil)))
(widget-put widget :custom-magic magic)
(push magic buttons))
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
(widget-put widget :documentation-indent 3)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
;; The comment field
(unless hiddenp
(let* ((comment (get symbol 'face-comment))
(comment-widget
(widget-create-child-and-convert
widget 'custom-comment
:parent widget
:value (or comment ""))))
(widget-put widget :comment-widget comment-widget)
(push comment-widget children)))
;; Editor.
(unless (eq (preceding-char) ?\n)
(insert "\n"))
(unless hiddenp
(custom-load-widget widget)
(unless (widget-get widget :custom-form)
(widget-put widget :custom-form custom-face-default-form))
(let* ((spec (or (get symbol 'customized-face)
(get symbol 'saved-face)
(get symbol 'face-defface-spec)
;; Attempt to construct it.
(list (list t (custom-face-attributes-get
symbol (selected-frame))))))
(form (widget-get widget :custom-form))
(indent (widget-get widget :indent))
edit-widget-type edit)
;; If the user has changed this face in some other way,
;; edit it as the user has specified it.
(if (not (face-spec-match-p symbol spec (selected-frame)))
(setq spec `((t ,(face-attr-construct symbol
(selected-frame))))))
(setq spec (custom-pre-filter-face-spec spec))
(cond ((and (eq form 'selected)
(widget-apply custom-face-selected :match spec))
(when indent (insert-char ?\s indent))
(setq edit-widget-type 'custom-face-selected))
((and (not (eq form 'lisp))
(widget-apply custom-face-all :match spec))
(setq edit-widget-type 'custom-face-all))
(t
(when indent
(insert-char ?\s indent))
(setq edit-widget-type 'sexp)))
(setq edit (widget-create-child-and-convert
widget edit-widget-type :value spec))
(custom-face-state-set widget)
(push edit children)
(widget-put widget :children children))))))
(defvar custom-face-menu
`(("Set for Current Session" custom-face-set)
......
......@@ -2237,11 +2237,10 @@ when he invoked the menu."
(defun widget-checklist-value-create (widget)
;; Insert all values
(let ((alist (widget-checklist-match-find widget (widget-get widget :value)))
(args (widget-get widget :args)))
(while args
(widget-checklist-add-item widget (car args) (assq (car args) alist))
(setq args (cdr args)))
(let ((alist (widget-checklist-match-find widget))
(args (widget-get widget :args)))
(dolist (item args)
(widget-checklist-add-item widget item (assq item alist)))
(widget-put widget :children (nreverse (widget-get widget :children)))))
(defun widget-checklist-add-item (widget type chosen)
......@@ -2314,9 +2313,10 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
values nil)))))
(cons found rest)))
(defun widget-checklist-match-find (widget vals)
(defun widget-checklist-match-find (widget &optional vals)
"Find the vals which match a type in the checklist.
Return an alist of (TYPE MATCH)."
(or vals (setq vals (widget-get widget :value)))
(let ((greedy (widget-get widget :greedy))
(args (copy-sequence (widget-get widget :args)))
found)
......@@ -2809,11 +2809,10 @@ Return an alist of (TYPE MATCH)."
argument answer found)
(while args
(setq argument (car args)
args (cdr args)
answer (widget-match-inline argument vals))
(if answer
(setq vals (cdr answer)
found (append found (car answer)))
args (cdr args))
(if (setq answer (widget-match-inline argument vals))
(setq found (append found (car answer))
vals (cdr answer))
(setq vals nil
args nil)))
(if answer
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment