Commit 587faadd authored by Chong Yidong's avatar Chong Yidong

More face customization cleanups.

* cus-edit.el (custom-commands, custom-buffer-create-internal)
(custom-magic-value-create): Pad button tags with spaces.
(custom-face-edit): New variable.
(custom-face-value-create): Determine whether to use the usual
face editor here, instead of using custom-face-selected.  Pass
face defaults to custom-face-edit widget.
(custom-face-selected, custom-display-unselected): Delete widgets.
(custom-display-unselected-match): Function removed.
(custom-face-set, custom-face-mark-to-save): Accept
custom-face-edit widgets as the direct widget child.

* wid-edit.el (widget--completing-widget): New var.
(widget-default-complete): Bind it when doing completion.
(widget-string-complete, widget-file-complete): Use it.
parent 85d50db7
2010-10-08 Chong Yidong <cyd@stupidchicken.com>
* cus-edit.el (custom-commands, custom-buffer-create-internal)
(custom-magic-value-create): Pad button tags with spaces.
(custom-face-edit): New variable.
(custom-face-value-create): Determine whether to use the usual
face editor here, instead of using custom-face-selected. Pass
face defaults to custom-face-edit widget.
(custom-face-selected, custom-display-unselected): Delete widgets.
(custom-display-unselected-match): Function removed.
(custom-face-set, custom-face-mark-to-save): Accept
custom-face-edit widgets as the direct widget child.
* wid-edit.el (widget--completing-widget): New var.
(widget-default-complete): Bind it when doing completion.
(widget-string-complete, widget-file-complete): Use it.
2010-10-09 Glenn Morris <rgm@gnu.org>
* calendar/cal-hebrew.el (holiday-hebrew-rosh-hashanah)
......
......@@ -738,33 +738,33 @@ groups after non-groups, if nil do not order groups at all."
;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
'(("Set for current session" Custom-set t
'((" Set for current session " Custom-set t
"Apply all settings in this buffer to the current session"
"index"
"Apply")
("Save for future sessions" Custom-save
(" Save for future sessions " Custom-save
(or custom-file user-init-file)
"Apply all settings in this buffer and save them for future Emacs sessions."
"save"
"Save")
("Undo edits" Custom-reset-current t
(" Undo edits " Custom-reset-current t
"Restore all settings in this buffer to reflect their current values."
"refresh"
"Undo")
("Reset to saved" Custom-reset-saved t
(" Reset to saved " Custom-reset-saved t
"Restore all settings in this buffer to their saved values (if any)."
"undo"
"Reset")
("Erase customizations" Custom-reset-standard
(" Erase customizations " Custom-reset-standard
(or custom-file user-init-file)
"Un-customize all settings in this buffer and save them with standard values."
"delete"
"Uncustomize")
("Help for Customize" Custom-help t
(" Help for Customize " Custom-help t
"Get help for using Customize."
"help"
"Help")
("Exit" Custom-buffer-done t "Exit Customize." "exit" "Exit")))
(" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit")))
(defun Custom-help ()
"Read the node on Easy Customization in the Emacs manual."
......@@ -1607,7 +1607,7 @@ Otherwise use brackets."
(widget-insert " ")
(widget-create-child-and-convert
search-widget 'push-button
:tag "Search"
:tag " Search "
:help-echo echo :action
(lambda (widget &optional event)
(customize-apropos (widget-value (widget-get widget :parent)))))
......@@ -2039,7 +2039,7 @@ and `face'."
:button-prefix 'widget-push-button-prefix
:button-suffix 'widget-push-button-suffix
:mouse-down-action 'widget-magic-mouse-down-action
:tag "State")
:tag " State ")
children)
(insert ": ")
(let ((start (point)))
......@@ -2455,7 +2455,6 @@ However, setting it through Custom sets the default value.")
(define-widget 'custom-variable 'custom
"A widget for displaying a Custom variable.
The following properties have special meanings for this widget:
:hidden-states should be a list of widget states for which the
......@@ -3032,7 +3031,13 @@ to switch between two values."
;;; The `custom-face-edit' Widget.
(define-widget 'custom-face-edit 'checklist
"Widget for editing face attributes."
"Widget for editing face attributes.
The following properties have special meanings for this widget:
:value is a plist of face attributes.
:default-face-attributes, if non-nil, is a plist of defaults for
face attributes (as specified by a `default' defface entry)."
:format "%v"
:extra-offset 3
:button-args '(:help-echo "Control whether this attribute has any effect.")
......@@ -3050,18 +3055,22 @@ to switch between two values."
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))
(let* ((alist (widget-checklist-match-find
widget (widget-get widget :value)))
(args (widget-get widget :args))
(show-all (widget-get widget :show-all-attributes))
(buttons (widget-get widget :buttons))
(buttons (widget-get widget :buttons))
(defaults (widget-checklist-match-find
widget
(widget-get widget :default-face-attributes)))
entry)
(unless (looking-back "^ *")
(insert ?\n))
(insert-char ?\s (widget-get widget :extra-offset))
(if (or alist show-all)
(if (or alist defaults show-all)
(dolist (prop args)
(setq entry (assq prop alist))
(setq entry (or (assq prop alist)
(assq prop defaults)))
(if (or entry show-all)
(widget-checklist-add-item widget prop entry)))
(insert (propertize "-- Empty face --" 'face 'shadow) ?\n))
......@@ -3127,6 +3136,9 @@ Also change :reverse-video to :inverse-video."
(widget-get widget :args)))
widget)
(defconst custom-face-edit (widget-convert 'custom-face-edit)
"Converted version of the `custom-face-edit' widget.")
(defun custom-face-edit-deactivate (widget)
"Make face widget WIDGET inactive for user modifications."
(unless (widget-get widget :inactive)
......@@ -3282,15 +3294,22 @@ Only match frames that support the specified face attributes.")
(define-widget 'custom-face 'custom
"Widget for customizing a face.
The widget value is the face name (a symbol).
The following properties have special meanings for this widget:
:value is the face name (a symbol).
: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'."
the return value of `custom-face-default-form'.
:display-style, if non-nil, should be a symbol describing the
style of display to use. If the value is `concise', a more
concise interface is shown.
:sample-indent, if non-nil, should be an integer; this is the
number of columns to which to indent the face sample."
:sample-face 'custom-face-tag
:help-echo "Set or reset this face."
:documentation-property #'face-doc-string
......@@ -3319,29 +3338,6 @@ The following properties have special meanings for this widget:
(defconst custom-face-all (widget-convert 'custom-face-all)
"Converted version of the `custom-face-all' widget.")
(define-widget 'custom-display-unselected 'item
"A display specification that doesn't match the selected display."
:match 'custom-display-unselected-match)
(defun custom-display-unselected-match (widget value)
"Non-nil if VALUE is an unselected display specification."
(not (face-spec-set-match-display value (selected-frame))))
(define-widget 'custom-face-selected 'group
"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.")
(defun custom-filter-face-spec (spec filter-index &optional default-filter)
"Return a canonicalized version of SPEC using.
FILTER-INDEX is the index in the entry for each attribute in
......@@ -3390,6 +3386,7 @@ SPEC must be a full face spec."
(tag (or (widget-get widget :tag)
(prin1-to-string symbol)))
(hiddenp (eq (widget-get widget :custom-state) 'hidden))
(style (widget-get widget :display-style))
children)
(if (eq custom-buffer-style 'tree)
......@@ -3424,9 +3421,14 @@ SPEC must be a full face spec."
(t " face: ")))
;; Face sample.
(let ((sample-indent (widget-get widget :sample-indent))
(indent-tabs-mode nil))
(and sample-indent
(<= (current-column) sample-indent)
(indent-to-column sample-indent)))
(push (widget-create-child-and-convert
widget 'item
:format "(%{%t%})" :sample-face symbol :tag "sample")
:format "[%{%t%}]" :sample-face symbol :tag "sample")
buttons)
;; Magic.
(insert "\n")
......@@ -3439,19 +3441,20 @@ SPEC must be a full face spec."
(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)))
(unless (and hiddenp (eq style 'concise))
(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)
......@@ -3469,7 +3472,7 @@ SPEC must be a full face spec."
symbol (selected-frame))))))
(form (widget-get widget :custom-form))
(indent (widget-get widget :indent))
edit-widget-type edit)
face-alist face-entry spec-default spec-match editor)
;; 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)))
......@@ -3477,21 +3480,42 @@ SPEC must be a full face spec."
(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))
;; Find a display in SPEC matching the selected display.
;; This will use the usual face customization interface.
(setq face-alist spec)
(when (eq (car-safe (car-safe face-alist)) 'default)
(setq spec-default (pop face-alist)))
(while (and face-alist (listp face-alist) (null spec-match))
(setq face-entry (car face-alist))
(and (listp face-entry)
(face-spec-set-match-display (car face-entry)
(selected-frame))
(widget-apply custom-face-edit :match (cadr face-entry))
(setq spec-match face-entry))
(setq face-alist (cdr face-alist)))
;; Insert the appropriate editing widget.
(setq editor
(cond
((and (eq form 'selected)
(or spec-match spec-default))
(when indent (insert-char ?\s indent))
(widget-create-child-and-convert
widget 'custom-face-edit
:value (cadr spec-match)
:default-face-attributes (cadr spec-default)))
((and (not (eq form 'lisp))
(widget-apply custom-face-all :match spec))
(widget-create-child-and-convert
widget 'custom-face-all :value spec))
(t
(when indent
(insert-char ?\s indent))
(widget-create-child-and-convert
widget 'sexp :value spec))))
(custom-face-state-set widget)
(push edit children)
(push editor children)
(widget-put widget :children children))))))
(defvar custom-face-menu
......@@ -3603,7 +3627,10 @@ Optional EVENT is the location for the menu."
"Make the face attributes in WIDGET take effect."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (custom-post-filter-face-spec (widget-value child)))
(value (custom-post-filter-face-spec
(if (eq (widget-type child) 'custom-face-edit)
`((t ,(widget-value child)))
(widget-value child))))
(comment-widget (widget-get widget :comment-widget))
(comment (widget-value comment-widget)))
(when (equal comment "")
......@@ -3626,7 +3653,10 @@ Optional EVENT is the location for the menu."
"Mark for saving the face edited by WIDGET."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (custom-post-filter-face-spec (widget-value child)))
(value (custom-post-filter-face-spec
(if (eq (widget-type child) 'custom-face-edit)
`((t ,(widget-value child)))
(widget-value child))))
(comment-widget (widget-get widget :comment-widget))
(comment (widget-value comment-widget)))
(when (equal comment "")
......
......@@ -57,8 +57,6 @@
;;; Code:
(defvar widget)
;;; Compatibility.
(defun widget-event-point (event)
......@@ -1462,11 +1460,15 @@ The value of the :type attribute should be an unconverted widget type."
:notify 'widget-default-notify
:prompt-value 'widget-default-prompt-value)
(defvar widget--completing-widget)
(defun widget-default-complete (widget)
"Call the value of the :complete-function property of WIDGET.
If that does not exist, call the value of `widget-complete-field'."
(call-interactively (or (widget-get widget :complete-function)
widget-complete-field)))
If that does not exist, call the value of `widget-complete-field'.
During this call, `widget--completing-widget' is bound to WIDGET."
(let ((widget--completing-widget widget))
(call-interactively (or (widget-get widget :complete-function)
widget-complete-field))))
(defun widget-default-create (widget)
"Create WIDGET at point in the current buffer."
......@@ -3048,14 +3050,13 @@ as the value."
:complete-function 'ispell-complete-word
:prompt-history 'widget-string-prompt-value-history)
(defvar widget)
(defun widget-string-complete ()
"Complete contents of string field.
Completions are taken from the :completion-alist property of the
widget. If that isn't a list, it's evalled and expected to yield a list."
(interactive)
(let* ((completion-ignore-case (widget-get widget :completion-ignore-case))
(let* ((widget widget--completing-widget)
(completion-ignore-case (widget-get widget :completion-ignore-case))
(alist (widget-get widget :completion-alist))
(_ (unless (listp alist)
(setq alist (eval alist)))))
......@@ -3100,9 +3101,10 @@ It reads a file name from an editable text field."
(defun widget-file-complete ()
"Perform completion on file name preceding point."
(interactive)
(completion-in-region (widget-field-start widget)
(max (point) (widget-field-text-end widget))
'completion-file-name-table))
(let ((widget widget--completing-widget))
(completion-in-region (widget-field-start widget)
(max (point) (widget-field-text-end widget))
'completion-file-name-table)))
(defun widget-file-prompt-value (widget prompt value unbound)
;; Read file from minibuffer.
......@@ -3725,7 +3727,7 @@ example:
(widget-insert " ")
(widget-create-child-and-convert
widget 'push-button
:tag "Choose" :action 'widget-color--choose-action)
:tag " Choose " :action 'widget-color--choose-action)
(widget-insert " "))
(defun widget-color--choose-action (widget &optional event)
......
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