# HG changeset patch # User Chong Yidong # Date 1286594618 14400 # Node ID 7a9a2861c2c23da63295405b89d6839f9d0a20d5 # Parent 3684139b9255ff85ee01710bb8d0e33682f51360 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. diff -r 3684139b9255 -r 7a9a2861c2c2 lisp/ChangeLog --- a/lisp/ChangeLog Fri Oct 08 19:25:38 2010 -0700 +++ b/lisp/ChangeLog Fri Oct 08 23:23:38 2010 -0400 @@ -1,3 +1,20 @@ +2010-10-08 Chong Yidong + + * 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 * calendar/cal-hebrew.el (holiday-hebrew-rosh-hashanah) diff -r 3684139b9255 -r 7a9a2861c2c2 lisp/cus-edit.el --- a/lisp/cus-edit.el Fri Oct 08 19:25:38 2010 -0700 +++ b/lisp/cus-edit.el Fri Oct 08 23:23:38 2010 -0400 @@ -738,33 +738,33 @@ ;; `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 @@ (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 @@ :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 @@ (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 @@ ;;; 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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ "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 @@ "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 "") diff -r 3684139b9255 -r 7a9a2861c2c2 lisp/wid-edit.el --- a/lisp/wid-edit.el Fri Oct 08 19:25:38 2010 -0700 +++ b/lisp/wid-edit.el Fri Oct 08 23:23:38 2010 -0400 @@ -57,8 +57,6 @@ ;;; Code: -(defvar widget) - ;;; Compatibility. (defun widget-event-point (event) @@ -1462,11 +1460,15 @@ :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 @@ :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 @@ (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 @@ (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)