1367 |
:group 'custom-buffer) |
:group 'custom-buffer) |
1368 |
|
|
1369 |
(defun custom-buffer-create-internal (options &optional description) |
(defun custom-buffer-create-internal (options &optional description) |
|
(message "Creating customization buffer...") |
|
1370 |
(custom-mode) |
(custom-mode) |
1371 |
(if custom-buffer-verbose-help |
(if custom-buffer-verbose-help |
1372 |
(progn |
(progn |
1386 |
:help-echo "Read the online help." |
:help-echo "Read the online help." |
1387 |
"(emacs)Easy Customization") |
"(emacs)Easy Customization") |
1388 |
(widget-insert " for more information.\n\n") |
(widget-insert " for more information.\n\n") |
|
(message "Creating customization buttons...") |
|
1389 |
(widget-insert "Operate on everything in this buffer:\n ")) |
(widget-insert "Operate on everything in this buffer:\n ")) |
1390 |
(widget-insert " ")) |
(widget-insert " ")) |
1391 |
(widget-create 'push-button |
(widget-create 'push-button |
1476 |
(unless (eq (preceding-char) ?\n) |
(unless (eq (preceding-char) ?\n) |
1477 |
(widget-insert "\n")) |
(widget-insert "\n")) |
1478 |
(message "Creating customization items ...done") |
(message "Creating customization items ...done") |
1479 |
|
(message "Resetting customization items...") |
1480 |
(unless (eq custom-buffer-style 'tree) |
(unless (eq custom-buffer-style 'tree) |
1481 |
(mapc 'custom-magic-reset custom-options)) |
(mapc 'custom-magic-reset custom-options)) |
1482 |
|
(message "Resetting customization items...done") |
1483 |
(message "Creating customization setup...") |
(message "Creating customization setup...") |
1484 |
(widget-setup) |
(widget-setup) |
1485 |
(buffer-enable-undo) |
(buffer-enable-undo) |
1486 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1487 |
(message "Creating customization buffer...done")) |
(message "Creating customization setup...done")) |
1488 |
|
|
1489 |
;;; The Tree Browser. |
;;; The Tree Browser. |
1490 |
|
|
1675 |
the value displayed for this %c is invalid and cannot be set.") |
the value displayed for this %c is invalid and cannot be set.") |
1676 |
(modified "*" custom-modified-face "\ |
(modified "*" custom-modified-face "\ |
1677 |
you have edited the value as text, but you have not set the %c." "\ |
you have edited the value as text, but you have not set the %c." "\ |
1678 |
you have edited something in this group, but not set anything yet.") |
something in this group has been edited but not set.") |
1679 |
(set "+" custom-set-face "\ |
(set "+" custom-set-face "\ |
1680 |
you have set this %c, but not saved it for future sessions." "\ |
you have set this %c, but not saved it for future sessions." "\ |
1681 |
you have set something in this group, but not saved anything yet.") |
something in this group has been set but not saved.") |
1682 |
(changed ":" custom-changed-face "\ |
(changed ":" custom-changed-face "\ |
1683 |
this %c has been changed outside the customize buffer." "\ |
this %c has been changed outside the customize buffer." "\ |
1684 |
something in this group has been changed outside customize.") |
something in this group has been changed outside customize.") |
1685 |
(saved "!" custom-saved-face "\ |
(saved "!" custom-saved-face "\ |
1686 |
You have set this %c and saved it through Customize in your init file." "\ |
You've set this %c and Customize saved it in your init file." "\ |
1687 |
something in this group has been set and saved.") |
something in this group has been set and saved.") |
1688 |
(rogue "@" custom-rogue-face "\ |
(rogue "@" custom-rogue-face "\ |
1689 |
this %c has not been changed with customize." "\ |
this %c has not been changed with customize." "\ |
3285 |
|
|
3286 |
;;; The `face' Widget. |
;;; The `face' Widget. |
3287 |
|
|
3288 |
(define-widget 'face 'default |
(defvar widget-face-prompt-value-history nil |
3289 |
"Select and customize a face." |
"History of input to `widget-face-prompt-value'.") |
3290 |
:convert-widget 'widget-value-convert-widget |
|
3291 |
:button-prefix 'widget-push-button-prefix |
(define-widget 'face 'restricted-sexp |
3292 |
:button-suffix 'widget-push-button-suffix |
"A Lisp face name." |
3293 |
:format "%{%t%}: %[select face%] %v" |
:complete-function (lambda () |
3294 |
:tag "Face" |
(interactive) |
3295 |
:value 'default |
(lisp-complete-symbol 'facep)) |
3296 |
|
:prompt-value 'widget-field-prompt-value |
3297 |
|
:prompt-internal 'widget-symbol-prompt-internal |
3298 |
|
:prompt-match 'facep |
3299 |
|
:prompt-history 'widget-face-prompt-value-history |
3300 |
:value-create 'widget-face-value-create |
:value-create 'widget-face-value-create |
3301 |
:value-delete 'widget-face-value-delete |
:action 'widget-field-action |
3302 |
:value-get 'widget-value-value-get |
:match-alternatives '(facep) |
3303 |
:validate 'widget-children-validate |
:validate (lambda (widget) |
3304 |
:action 'widget-face-action |
(unless (facep (widget-value widget)) |
3305 |
:match (lambda (widget value) (symbolp value))) |
(widget-put widget :error (format "Invalid face: %S" |
3306 |
|
(widget-value widget))) |
3307 |
|
widget)) |
3308 |
|
:value 'ignore |
3309 |
|
:tag "Function") |
3310 |
|
|
3311 |
|
|
3312 |
|
;;; There is a bug here: the sample doesn't get redisplayed |
3313 |
|
;;; in the new font when you specify one. Does anyone know how to |
3314 |
|
;;; make that work? -- rms. |
3315 |
|
|
3316 |
(defun widget-face-value-create (widget) |
(defun widget-face-value-create (widget) |
3317 |
"Create a `custom-face' child." |
"Create an editable face name field." |
3318 |
(let* ((symbol (widget-value widget)) |
(let ((buttons (widget-get widget :buttons)) |
3319 |
(custom-buffer-style 'face) |
(symbol (widget-get widget :value))) |
3320 |
(child (widget-create-child-and-convert |
;; Sample. |
3321 |
widget 'custom-face |
(push (widget-create-child-and-convert widget 'item |
3322 |
:custom-level nil |
:format "(%{%t%})" |
3323 |
:value symbol))) |
:sample-face symbol |
3324 |
(custom-magic-reset child) |
:tag "sample") |
3325 |
(setq custom-options (cons child custom-options)) |
buttons) |
3326 |
(widget-put widget :children (list child)))) |
(insert " ") |
3327 |
|
;; Update buttons. |
3328 |
(defun widget-face-value-delete (widget) |
(widget-put widget :buttons buttons)) |
3329 |
"Remove the child from the options." |
|
3330 |
(let ((child (car (widget-get widget :children)))) |
(let ((size (widget-get widget :size)) |
3331 |
(setq custom-options (delq child custom-options)) |
(value (widget-get widget :value)) |
3332 |
(widget-children-value-delete widget))) |
(from (point)) |
3333 |
|
;; This is changed to a real overlay in `widget-setup'. We |
3334 |
(defvar face-history nil |
;; need the end points to behave differently until |
3335 |
"History of entered face names.") |
;; `widget-setup' is called. |
3336 |
|
(overlay (cons (make-marker) (make-marker)))) |
3337 |
(defun widget-face-action (widget &optional event) |
(widget-put widget :field-overlay overlay) |
3338 |
"Prompt for a face." |
(insert value) |
3339 |
(let ((answer (completing-read "Face: " |
(and size |
3340 |
(mapcar (lambda (face) |
(< (length value) size) |
3341 |
(list (symbol-name face))) |
(insert-char ?\ (- size (length value)))) |
3342 |
(face-list)) |
(unless (memq widget widget-field-list) |
3343 |
nil nil nil |
(setq widget-field-new (cons widget widget-field-new))) |
3344 |
'face-history))) |
(move-marker (cdr overlay) (point)) |
3345 |
(unless (zerop (length answer)) |
(set-marker-insertion-type (cdr overlay) nil) |
3346 |
(widget-value-set widget (intern answer)) |
(when (null size) |
3347 |
(widget-apply widget :notify widget event) |
(insert ?\n)) |
3348 |
(widget-setup)))) |
(move-marker (car overlay) from) |
3349 |
|
(set-marker-insertion-type (car overlay) t))) |
3350 |
|
|
3351 |
|
|
3352 |
;;; The `hook' Widget. |
;;; The `hook' Widget. |
3353 |
|
|