;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.65
+;; Version: 1.70
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(mapcar (lambda (symbol)
(setq found (cons (list symbol 'custom-face) found)))
(face-list))
- (message "Creating customization buffer...")
(custom-buffer-create found))
(if (stringp symbol)
(setq symbol (intern symbol)))
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
+ (message "Creating customization buffer...")
(kill-buffer (get-buffer-create "*Customization*"))
(switch-to-buffer (get-buffer-create "*Customization*"))
(custom-mode)
(widget-insert "This is a customization buffer.
Push RET or click mouse-2 on the word ")
+ ;; (put-text-property 1 2 'start-open nil)
(widget-create 'info-link
:tag "help"
:help-echo "Read the online help."
"(custom)The Customization Buffer")
(widget-insert " for more information.\n\n")
(setq custom-options
- (mapcar (lambda (entry)
- (prog1
- (if (> (length options) 1)
- (widget-create (nth 1 entry)
+ (if (= (length options) 1)
+ (mapcar (lambda (entry)
+ (widget-create (nth 1 entry)
+ :custom-state 'unknown
+ :tag (custom-unlispify-tag-name
+ (nth 0 entry))
+ :value (nth 0 entry)))
+ options)
+ (let ((count 0)
+ (length (length options)))
+ (mapcar (lambda (entry)
+ (prog2
+ (message "Creating customization items %2d%%..."
+ (/ (* 100.0 count) length))
+ (widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name
(nth 0 entry))
:value (nth 0 entry))
- ;; If there is only one entry, don't hide it!
- (widget-create (nth 1 entry)
- :custom-state 'unknown
- :tag (custom-unlispify-tag-name
- (nth 0 entry))
- :value (nth 0 entry)))
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))
- (widget-insert "\n")))
- options))
+ (setq count (1+ count))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ (widget-insert "\n")))
+ options))))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ (widget-insert "\n")
+ (message "Creating customization magic...")
(mapcar 'custom-magic-reset custom-options)
+ (message "Creating customization buttons...")
(widget-create 'push-button
:tag "Set"
:help-echo "Set all modifications for this session."
(when (memq 'down (event-modifiers event))
(read-event)))))
(widget-insert "\n")
+ (message "Creating customization setup...")
(widget-setup)
- (goto-char (point-min)))
+ (goto-char (point-min))
+ (message "Creating customization buffer...done"))
;;; Modification of Basic Widgets.
;;
(face-doc-string face))
:value-create 'custom-face-value-create
:action 'custom-face-action
+ :custom-form 'selected
:custom-set 'custom-face-set
:custom-save 'custom-face-save
:custom-reset-current 'custom-redraw
(widget-put widget
:buttons (cons child (widget-get widget :buttons))))))
+(define-widget 'custom-face-all 'editable-list
+ "An editable list of display specifications and attributes."
+ :entry-format "%i %d %v"
+ :insert-button-args '(:help-echo "Insert new display specification here.")
+ :append-button-args '(:help-echo "Append new display specification here.")
+ :delete-button-args '(:help-echo "Delete this display specification.")
+ :args '((group :format "%v" custom-display custom-face-edit)))
+
+(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."
+ (and (listp value)
+ (eq (length value) 2)
+ (not (custom-display-match-frame value (selected-frame)))))
+
+(define-widget 'custom-face-selected 'group
+ "Edit the attributes of the selected display in a face specification."
+ :args '((repeat :format ""
+ :inline t
+ (group custom-display-unselected sexp))
+ (group (sexp :format "") custom-face-edit)
+ (repeat :format ""
+ :inline t
+ sexp)))
+
+(defconst custom-face-selected (widget-convert 'custom-face-selected)
+ "Converted version of the `custom-face-selected' widget.")
+
(defun custom-face-value-create (widget)
;; Create a list of the display specifications.
(unless (eq (preceding-char) ?\n)
(insert "\n"))
(when (not (eq (widget-get widget :custom-state) 'hidden))
+ (message "Creating face editor...")
(custom-load-widget widget)
(let* ((symbol (widget-value widget))
+ (spec (or (get symbol 'saved-face)
+ (get symbol 'factory-face)
+ ;; 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-create-child-and-convert
- widget 'editable-list
- :entry-format "%i %d %v"
- :value (or (get symbol 'saved-face)
- (get symbol 'factory-face))
- :insert-button-args '(:help-echo "\
-Insert new display specification here.")
- :append-button-args '(:help-echo "\
-Append new display specification here.")
- :delete-button-args '(:help-echo "\
-Delete this display specification.")
- '(group :format "%v"
- custom-display custom-face-edit))))
+ 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)
- (widget-put widget :children (list edit)))))
+ (widget-put widget :children (list edit)))
+ (message "Creating face editor...done")))
(defvar custom-face-menu
- '(("Set" . custom-face-set)
+ '(("Edit Selected" . custom-face-edit-selected)
+ ("Edit All" . custom-face-edit-all)
+ ("Edit Lisp" . custom-face-edit-lisp)
+ ("Set" . custom-face-set)
("Save" . custom-face-save)
("Reset to Saved" . custom-face-reset-saved)
("Reset to Factory Setting" . custom-face-reset-factory))
lisp function taking the widget as an element which will be called
when the action is chosen.")
+(defun custom-face-edit-selected (widget)
+ "Edit selected attributes of the value of WIDGET."
+ (widget-put widget :custom-state 'unknown)
+ (widget-put widget :custom-form 'selected)
+ (custom-redraw widget))
+
+(defun custom-face-edit-all (widget)
+ "Edit all attributes of the value of WIDGET."
+ (widget-put widget :custom-state 'unknown)
+ (widget-put widget :custom-form 'all)
+ (custom-redraw widget))
+
+(defun custom-face-edit-lisp (widget)
+ "Edit the lisp representation of the value of WIDGET."
+ (widget-put widget :custom-state 'unknown)
+ (widget-put widget :custom-form 'lisp)
+ (custom-redraw widget))
+
(defun custom-face-state-set (widget)
"Set the state of WIDGET."
(let ((symbol (widget-value widget)))
:group 'customize)
(defface custom-group-tag-face-1 '((((class color)
- (background dark))
- (:foreground "pink" :underline t))
- (((class color)
- (background light))
- (:foreground "red" :underline t))
- (t (:underline t)))
+ (background dark))
+ (:foreground "pink" :underline t))
+ (((class color)
+ (background light))
+ (:foreground "red" :underline t))
+ (t (:underline t)))
"Face used for group tags.")
(defface custom-group-tag-face '((((class color)
(defun custom-group-value-create (widget)
(let ((state (widget-get widget :custom-state)))
(unless (eq state 'hidden)
+ (message "Creating group...")
(custom-load-widget widget)
(let* ((level (widget-get widget :custom-level))
(symbol (widget-value widget))
(members (get symbol 'custom-group))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
+ (length (length members))
+ (count 0)
(children (mapcar (lambda (entry)
(widget-insert "\n")
+ (message "Creating group members... %2d%%"
+ (/ (* 100.0 count) length))
+ (setq count (1+ count))
(prog1
(widget-create-child-and-convert
widget (nth 1 entry)
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))))
members)))
+ (message "Creating group magic...")
(mapcar 'custom-magic-reset children)
+ (message "Creating group state...")
(widget-put widget :children children)
- (custom-group-state-update widget)))))
+ (custom-group-state-update widget)
+ (message "Creating group... done")))))
(defvar custom-group-menu
'(("Set" . custom-group-set)
(princ ")")
(princ " t)"))))))
(princ ")")
- (unless (eolp)
+ (unless (looking-at "\n")
(princ "\n")))))
(defun custom-save-faces ()
(princ ")")
(princ " t)"))))))
(princ ")")
- (unless (eolp)
+ (unless (looking-at "\n")
(princ "\n")))))
+;;;###autoload
(defun custom-save-all ()
"Save all customizations in `custom-file'."
(custom-save-variables)
projects / gnus / blobdiff