[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r101839: Improvements to face customi
|
From: |
Chong Yidong |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r101839: Improvements to face customization interface. |
|
Date: |
Thu, 07 Oct 2010 20:05:12 -0400 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 101839
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Thu 2010-10-07 20:05:12 -0400
message:
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.
modified:
lisp/ChangeLog
lisp/cus-edit.el
lisp/wid-edit.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-10-07 17:30:10 +0000
+++ b/lisp/ChangeLog 2010-10-08 00:05:12 +0000
@@ -1,3 +1,18 @@
+2010-10-07 Chong Yidong <address@hidden>
+
+ * 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 <address@hidden>
* hilit-chg.el (hilit-chg-get-diff-info, hilit-chg-get-diff-list-hk):
=== modified file 'lisp/cus-edit.el'
--- a/lisp/cus-edit.el 2010-08-29 16:17:13 +0000
+++ b/lisp/cus-edit.el 2010-10-08 00:05:12 +0000
@@ -1914,7 +1914,7 @@
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 @@
(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 @@
;;; 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 @@
(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 @@
: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 @@
(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 @@
(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)
=== modified file 'lisp/wid-edit.el'
--- a/lisp/wid-edit.el 2010-08-29 16:17:13 +0000
+++ b/lisp/wid-edit.el 2010-10-08 00:05:12 +0000
@@ -2237,11 +2237,10 @@
(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 @@
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 @@
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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r101839: Improvements to face customization interface.,
Chong Yidong <=