/[emacs]/emacs/lisp/cus-edit.el
ViewVC logotype

Diff of /emacs/lisp/cus-edit.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.213 by teirllm, Tue Feb 22 23:12:15 2005 UTC revision 1.214 by rms, Sun Feb 27 10:34:05 2005 UTC
# Line 1367  Otherwise use brackets." Line 1367  Otherwise use brackets."
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
# Line 1387  Invoke " (if custom-raised-buttons Line 1386  Invoke " (if custom-raised-buttons
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
# Line 1478  Un-customize all values in this buffer. Line 1476  Un-customize all values in this buffer.
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    
# Line 1675  group now hidden, invoke \"Show\", above Line 1675  group now hidden, invoke \"Show\", above
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." "\
# Line 3285  restoring it to the state of a face that Line 3285  restoring it to the state of a face that
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    

Legend:
Removed from v.1.213  
changed lines
  Added in v.1.214

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26