;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.48
+;; Version: 1.55
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
;;; Code:
-(require 'custom)
+(require 'cus-face)
(require 'wid-edit)
(require 'easymenu)
(define-widget-keywords :custom-prefixes :custom-menu :custom-show
:custom-magic :custom-state :custom-level :custom-form
- :custom-set :custom-save :custom-reset-current :custom-reset-saved
+ :custom-set :custom-save :custom-reset-current :custom-reset-saved
:custom-reset-factory)
;;; Customization Groups.
(defgroup customize '((widgets custom-group))
"Customization of the Customization support."
:link '(custom-manual "(custom)Top")
- :link '(url-link :tag "Development Page"
+ :link '(url-link :tag "Development Page"
"http://www.dina.kvl.dk/~abraham/custom/")
:prefix "custom-"
:group 'help
(defun custom-split-regexp-maybe (regexp)
"If REGEXP is a string, split it to a list at `\\|'.
-You can get the original back with from the result with:
+You can get the original back with from the result with:
(mapconcat 'identity result \"\\|\")
IF REGEXP is not a string, return it unchanged."
(while prefixes
(setq prefix (car prefixes))
(if (search-forward prefix (+ (point) (length prefix)) t)
- (progn
+ (progn
(setq prefixes nil)
(delete-region (point-min) (point)))
(setq prefixes (cdr prefixes)))))
(subst-char-in-region (point-min) (point-max) ?- ?\ t)
(capitalize-region (point-min) (point-max))
- (unless no-suffix
+ (unless no-suffix
(goto-char (point-max))
(insert "..."))
(buffer-string)))))
(defvar custom-mode-map nil
"Keymap for `custom-mode'.")
-
+
(unless custom-mode-map
(setq custom-mode-map (make-sparse-keymap))
- (set-keymap-parent custom-mode-map widget-keymap))
+ (set-keymap-parent custom-mode-map widget-keymap)
+ (define-key custom-mode-map "q" 'bury-buffer))
-(easy-menu-define custom-mode-menu
+(easy-menu-define custom-mode-menu
custom-mode-map
"Menu used in customization buffers."
'("Custom"
\\[widget-button-press] Activate button under point.
\\[custom-set] Set all modifications.
\\[custom-save] Make all modifications default.
-\\[custom-reset-current] Reset all modified options.
+\\[custom-reset-current] Reset all modified options.
\\[custom-reset-saved] Reset all modified or set options.
\\[custom-reset-factory] Reset all options.
children))
(custom-save-all))
-(defvar custom-reset-menu
+(defvar custom-reset-menu
'(("Current" . custom-reset-current)
("Saved" . custom-reset-saved)
("Factory Settings" . custom-reset-factory))
(defun customize (symbol)
"Customize SYMBOL, which must be a customization group."
(interactive (list (completing-read "Customize group: (default emacs) "
- obarray
+ obarray
(lambda (symbol)
(get symbol 'custom-group))
t)))
(let ((v (variable-at-point))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
+ (setq val (completing-read
(if v
(format "Customize variable (default %s): " v)
"Customize variable: ")
(defun customize-face (&optional symbol)
"Customize SYMBOL, which should be a face name or nil.
If SYMBOL is nil, customize all faces."
- (interactive (list (completing-read "Customize face: (default all) "
+ (interactive (list (completing-read "Customize face: (default all) "
obarray 'custom-facep)))
(if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
(let ((found nil))
(boundp symbol)
(setq found
(cons (list symbol 'custom-variable) found)))))
- (if found
+ (if found
(custom-buffer-create found)
(error "No customized user options"))))
(user-variable-p symbol))))
(setq found
(cons (list symbol 'custom-variable) found))))))
- (if found
+ (if found
(custom-buffer-create found)
(error "No matches"))))
(custom-mode)
(widget-insert "This is a customization buffer.
Push RET or click mouse-2 on the word ")
- (widget-create 'info-link
+ (widget-create 'info-link
:tag "help"
:help-echo "Push me for help."
"(custom)The Customization Buffer")
(widget-insert " for more information.\n\n")
- (setq custom-options
+ (setq custom-options
(mapcar (lambda (entry)
- (prog1
+ (prog1
(if (> (length options) 1)
(widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name
(:underline t)))
"Face used when the customize item is not defined for customization.")
-(defface custom-modified-face '((((class color))
+(defface custom-modified-face '((((class color))
(:foreground "white" :background "blue"))
(t
(:italic t :bold)))
"Face used when the customize item has been modified.")
-(defface custom-set-face '((((class color))
+(defface custom-set-face '((((class color))
(:foreground "blue" :background "white"))
(t
(:italic t)))
"Face used when the customize item has been set.")
-(defface custom-changed-face '((((class color))
+(defface custom-changed-face '((((class color))
(:foreground "white" :background "blue"))
(t
(:italic t)))
(factory " " nil "\
this item is unchanged from its factory setting."))
"Alist of customize option states.
-Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where
+Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where
STATE is one of the following symbols:
`unknown'
For internal use, should never occur.
`hidden'
- This item is not being displayed.
+ This item is not being displayed.
`invalid'
This item is modified, but has an invalid form.
`modified'
:type '(list (checklist :inline t
(group (const nil)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const unknown)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const hidden)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const invalid)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const modified)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const set)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const changed)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const saved)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const rogue)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const factory)
(string :tag "Magic")
- face
+ face
(string :tag "Description")))
(editable-list :inline t
(group symbol
(lisp (eq (widget-get parent :custom-form) 'lisp))
children)
(when custom-magic-show
- (push (widget-create-child-and-convert widget 'choice-item
+ (push (widget-create-child-and-convert widget 'choice-item
:help-echo "\
Push me to change the state of this item."
:format "%[%t%]"
(if (eq custom-magic-show 'long)
(insert text)
(insert (symbol-name state)))
- (when lisp
+ (when lisp
(insert " (lisp)"))
(insert "\n"))
(when custom-magic-show-button
(let ((indent (widget-get parent :indent)))
(when indent
(insert-char ? indent))))
- (push (widget-create-child-and-convert widget 'choice-item
+ (push (widget-create-child-and-convert widget 'choice-item
:button-face face
:help-echo "\
Push me to change the state."
:format "%[%t%]"
- :tag (if lisp
+ :tag (if lisp
(concat "(" magic ")")
(concat "[" magic "]")))
children)
(defun custom-convert-widget (widget)
;; Initialize :value and :tag from :args in WIDGET.
(let ((args (widget-get widget :args)))
- (when args
+ (when args
(widget-put widget :value (widget-apply widget
:value-to-internal (car args)))
(widget-put widget :tag (custom-unlispify-tag-name (car args)))
(state (widget-get widget :custom-state))
(level (widget-get widget :custom-level)))
(cond ((eq escape ?l)
- (when level
+ (when level
(push (widget-create-child-and-convert
widget 'custom-level (make-string level ?*))
buttons)
(if many
(insert ", and ")
(insert " and ")))
- (t
+ (t
(insert ", "))))
(widget-put widget :buttons buttons))))
- (t
+ (t
(widget-default-format-handler widget escape)))))
(defun custom-notify (widget &rest args)
(defun custom-redraw-magic (widget)
"Redraw WIDGET state with current settings."
- (while widget
+ (while widget
(let ((magic (widget-get widget :custom-magic)))
- (unless magic
+ (unless magic
(debug))
(widget-value-set magic (widget-value magic))
(when (setq widget (widget-get widget :group))
;; Now we can create the child widget.
(cond ((eq state 'hidden)
;; Indicate hidden value.
- (push (widget-create-child-and-convert
+ (push (widget-create-child-and-convert
widget 'item
:format "%{%t%}: ..."
:sample-face 'custom-variable-sample-face
(custom-quote (default-value symbol)))
(t
(custom-quote (widget-get conv :value))))))
- (push (widget-create-child-and-convert
- widget 'sexp
+ (push (widget-create-child-and-convert
+ widget 'sexp
:button-face 'custom-variable-button-face
:tag (symbol-name symbol)
:parent widget
(t
;; Edit mode.
(push (widget-create-child-and-convert
- widget type
+ widget type
:tag tag
:button-face 'custom-variable-button-face
:sample-face 'custom-variable-sample-face
(if (eq state 'hidden)
(widget-put widget :custom-state state)
(custom-variable-state-set widget))
- (widget-put widget :custom-form form)
+ (widget-put widget :custom-form form)
(widget-put widget :buttons buttons)
(widget-put widget :children children)))
(t 'rogue))))
(widget-put widget :custom-state state)))
-(defvar custom-variable-menu
+(defvar custom-variable-menu
'(("Edit" . custom-variable-edit)
("Edit Lisp" . custom-variable-edit-lisp)
("Set" . custom-variable-set)
"Show the menu for `custom-variable' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
+ (progn
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
(defvar custom-face-edit-args
(mapcar (lambda (att)
- (list 'group
+ (list 'group
:inline t
- (list 'const :format "" :value (nth 0 att))
+ (list 'const :format "" :value (nth 0 att))
(nth 1 att)))
custom-face-attributes))
:tag "Attributes"
:extra-offset 12
:args (mapcar (lambda (att)
- (list 'group
+ (list 'group
:inline t
- (list 'const :format "" :value (nth 0 att))
+ (list 'const :format "" :value (nth 0 att))
(nth 1 att)))
custom-face-attributes))
:sample-face 'custom-face-tag-face
:help-echo "Push me to set or reset this face."
:documentation-property '(lambda (face)
- (get-face-documentation face))
+ (face-doc-string face))
:value-create 'custom-face-value-create
:action 'custom-face-action
:custom-set 'custom-face-set
;; XEmacs cannot display initialized faces.
(not (custom-facep symbol))
(copy-face 'custom-face-empty symbol))
- (setq child (widget-create-child-and-convert
+ (setq child (widget-create-child-and-convert
widget 'item
:format "(%{%t%})\n"
:sample-face symbol
:tag "sample")))
- (t
+ (t
(custom-format-handler widget escape)))
(when child
(widget-put widget
(custom-face-state-set widget)
(widget-put widget :children (list edit)))))
-(defvar custom-face-menu
+(defvar custom-face-menu
'(("Set" . custom-face-set)
("Save" . custom-face-save)
("Reset to Saved" . custom-face-reset-saved)
'saved)
((get symbol 'factory-face)
'factory)
- (t
+ (t
'rogue)))))
(defun custom-face-action (widget &optional event)
"Show the menu for `custom-face' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
+ (progn
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
(child (car (widget-get widget :children)))
(value (widget-value child)))
(put symbol 'customized-face value)
+ (when (fboundp 'copy-face)
+ (copy-face 'custom-face-empty symbol))
(custom-face-display-set symbol value)
(custom-face-state-set widget)
(custom-redraw-magic widget)))
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (widget-value child)))
+ (when (fboundp 'copy-face)
+ (copy-face 'custom-face-empty symbol))
(custom-face-display-set symbol value)
(put symbol 'saved-face value)
(put symbol 'customized-face nil)
(unless value
(error "No saved value for this face"))
(put symbol 'customized-face nil)
+ (when (fboundp 'copy-face)
+ (copy-face 'custom-face-empty symbol))
(custom-face-display-set symbol value)
(widget-value-set child value)
(custom-face-state-set widget)
(when (get symbol 'saved-face)
(put symbol 'saved-face nil)
(custom-save-all))
+ (when (fboundp 'copy-face)
+ (copy-face 'custom-face-empty symbol))
(custom-face-display-set symbol value)
(widget-value-set child value)
(custom-face-state-set widget)
(mapcar (lambda (face)
(list (symbol-name face)))
(face-list))
- nil nil nil
+ nil nil nil
'face-history)))
(unless (zerop (length answer))
(widget-value-set widget (intern answer))
(defun custom-hook-convert-widget (widget)
;; Handle `:custom-options'.
(let* ((options (widget-get widget :options))
- (other `(editable-list :inline t
+ (other `(editable-list :inline t
:entry-format "%i %d%v"
(function :format " %v")))
(args (if options
(widget-put widget :children children)
(custom-group-state-update widget)))))
-(defvar custom-group-menu
+(defvar custom-group-menu
'(("Set" . custom-group-set)
("Save" . custom-group-save)
("Reset to Current" . custom-group-reset-current)
"Show the menu for `custom-group' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
+ (progn
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
(defun custom-menu-create (symbol &optional name)
"Create menu for customization group SYMBOL.
-If optional NAME is given, use that as the name of the menu.
+If optional NAME is given, use that as the name of the menu.
Otherwise make up a name from SYMBOL.
The menu is in a format applicable to `easy-menu-define'."
(unless name
projects / gnus / blobdiff