Mercurial > emacs

changeset 110870:7a9a2861c2c2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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.
author Chong Yidong <cyd@stupidchicken.com>
date Fri, 08 Oct 2010 23:23:38 -0400
parents 3684139b9255
children bb1ecda9e4a9
files lisp/ChangeLog lisp/cus-edit.el lisp/wid-edit.el
diffstat 3 files changed, 134 insertions(+), 85 deletions(-) [+]
line wrap: on
line diff
--- 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  <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)
--- 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 "")
--- 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)