/[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.157 by miles, Mon Jun 10 02:51:18 2002 UTC revision 1.157.2.1 by miles, Fri Apr 4 06:20:01 2003 UTC
# Line 1  Line 1 
1  ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages  ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
2  ;;  ;;
3  ;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4  ;;  ;;
5  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>  ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6    ;; Maintainer: FSF
7  ;; Keywords: help, faces  ;; Keywords: help, faces
8    
9  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 25  Line 26 
26  ;;; Commentary:  ;;; Commentary:
27  ;;  ;;
28  ;; This file implements the code to create and edit customize buffers.  ;; This file implements the code to create and edit customize buffers.
29  ;;  ;;
30  ;; See `custom.el'.  ;; See `custom.el'.
31    
32  ;; No commands should have names starting with `custom-' because  ;; No commands should have names starting with `custom-' because
# Line 383  IF REGEXP is not a string, return it unc Line 384  IF REGEXP is not a string, return it unc
384      regexp))      regexp))
385    
386  (defun custom-variable-prompt ()  (defun custom-variable-prompt ()
387    "Prompt for a variable, defaulting to the variable at point.    "Prompt for a custom variable, defaulting to the variable at point.
388  Return a list suitable for use in `interactive'."  Return a list suitable for use in `interactive'."
389     (let ((v (variable-at-point))     (let ((v (variable-at-point))
390           (enable-recursive-minibuffers t)           (enable-recursive-minibuffers t)
391           val)           val)
392       (setq val (completing-read       (setq val (completing-read
393                  (if (symbolp v)                  (if (and (symbolp v) (custom-variable-p v))
394                      (format "Customize option: (default %s) " v)                      (format "Customize option: (default %s) " v)
395                    "Customize variable: ")                    "Customize option: ")
396                  obarray (lambda (symbol)                  obarray 'custom-variable-p t))
                           (and (boundp symbol)  
                                (or (get symbol 'custom-type)  
                                    (get symbol 'custom-loads)  
                                    (get symbol 'standard-value)))) t))  
397       (list (if (equal val "")       (list (if (equal val "")
398                 (if (symbolp v) v nil)                 (if (symbolp v) v nil)
399               (intern val)))))               (intern val)))))
# Line 443  WIDGET is the widget to apply the filter Line 440  WIDGET is the widget to apply the filter
440               (get symbol 'custom-tag)               (get symbol 'custom-tag)
441             (concat (get symbol 'custom-tag) "...")))             (concat (get symbol 'custom-tag) "...")))
442          (t          (t
443           (save-excursion           (with-current-buffer (get-buffer-create " *Custom-Work*")
            (set-buffer (get-buffer-create " *Custom-Work*"))  
444             (erase-buffer)             (erase-buffer)
445             (princ symbol (current-buffer))             (princ symbol (current-buffer))
446             (goto-char (point-min))             (goto-char (point-min))
447             (when (and (eq (get symbol 'custom-type) 'boolean)             ;; FIXME: Boolean variables are not predicates, so they shouldn't
448                        (re-search-forward "-p\\'" nil t))             ;; end with `-p'.  -stef
449               (replace-match "" t t)             ;; (when (and (eq (get symbol 'custom-type) 'boolean)
450               (goto-char (point-min)))             ;;         (re-search-forward "-p\\'" nil t))
451               ;;   (replace-match "" t t)
452               ;;   (goto-char (point-min)))
453             (if custom-unlispify-remove-prefixes             (if custom-unlispify-remove-prefixes
454                 (let ((prefixes custom-prefix-list)                 (let ((prefixes custom-prefix-list)
455                       prefix)                       prefix)
# Line 673  when the action is chosen.") Line 671  when the action is chosen.")
671    (interactive)    (interactive)
672    (let ((children custom-options))    (let ((children custom-options))
673      (mapc (lambda (widget)      (mapc (lambda (widget)
674              (and (default-boundp (widget-value widget))              (if (memq (widget-get widget :custom-state)
675                   (if (memq (widget-get widget :custom-state)                        '(modified changed))
676                             '(modified changed))                  (widget-apply widget :custom-reset-current)))
677                       (widget-apply widget :custom-reset-current))))            children)))
             children)))  
678    
679  (defun Custom-reset-saved (&rest ignore)  (defun Custom-reset-saved (&rest ignore)
680    "Reset all modified or set group members to their saved value."    "Reset all modified or set group members to their saved value."
681    (interactive)    (interactive)
682    (let ((children custom-options))    (let ((children custom-options))
683      (mapc (lambda (widget)      (mapc (lambda (widget)
684              (and (get (widget-value widget) 'saved-value)              (if (memq (widget-get widget :custom-state)
685                   (if (memq (widget-get widget :custom-state)                        '(modified set changed rogue))
686                             '(modified set changed rogue))                  (widget-apply widget :custom-reset-saved)))
687                       (widget-apply widget :custom-reset-saved))))            children)))
             children)))  
688    
689  (defun Custom-reset-standard (&rest ignore)  (defun Custom-reset-standard (&rest ignore)
690    "Erase all customization (either current or saved) for the group members.    "Erase all customization (either current or saved) for the group members.
# Line 698  making them as if they had never been cu Line 694  making them as if they had never been cu
694    (interactive)    (interactive)
695    (let ((children custom-options))    (let ((children custom-options))
696      (mapc (lambda (widget)      (mapc (lambda (widget)
697              (and (get (widget-value widget) 'standard-value)              (and (widget-apply widget :custom-standard-value)
698                   (if (memq (widget-get widget :custom-state)                   (if (memq (widget-get widget :custom-state)
699                             '(modified set changed saved rogue))                             '(modified set changed saved rogue))
700                       (widget-apply widget :custom-reset-standard))))                       (widget-apply widget :custom-reset-standard))))
# Line 761  If given a prefix (or a COMMENT argument Line 757  If given a prefix (or a COMMENT argument
757    (interactive (custom-prompt-variable "Set variable: "    (interactive (custom-prompt-variable "Set variable: "
758                                         "Set %s to value: "                                         "Set %s to value: "
759                                         current-prefix-arg))                                         current-prefix-arg))
760      
761    (cond ((string= comment "")    (cond ((string= comment "")
762           (put variable 'variable-comment nil))           (put variable 'variable-comment nil))
763          (comment          (comment
# Line 823  If given a prefix (or a COMMENT argument Line 819  If given a prefix (or a COMMENT argument
819                                         current-prefix-arg))                                         current-prefix-arg))
820    (funcall (or (get variable 'custom-set) 'set-default) variable value)    (funcall (or (get variable 'custom-set) 'set-default) variable value)
821    (put variable 'saved-value (list (custom-quote value)))    (put variable 'saved-value (list (custom-quote value)))
822      (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
823    (cond ((string= comment "")    (cond ((string= comment "")
824           (put variable 'variable-comment nil)           (put variable 'variable-comment nil)
825           (put variable 'saved-variable-comment nil))           (put variable 'saved-variable-comment nil))
# Line 842  are shown; the contents of those subgrou Line 839  are shown; the contents of those subgrou
839    (customize-group 'emacs))    (customize-group 'emacs))
840    
841  ;;;###autoload  ;;;###autoload
842    (defun customize-mode (mode)
843      "Customize options related to the current major mode.
844    If a prefix \\[universal-argument] was given (or if the current major mode has no known group),
845    then prompt for the MODE to customize."
846      (interactive
847       (list
848        (let ((completion-regexp-list '("-mode\\'"))
849              (group (custom-group-of-mode major-mode)))
850          (if (and group (not current-prefix-arg))
851              major-mode
852            (intern
853             (completing-read (if group
854                                  (format "Major mode (default %s): " major-mode)
855                                "Major mode: ")
856                              obarray
857                              'custom-group-of-mode
858                              t nil nil (if group (symbol-name major-mode))))))))
859      (customize-group (custom-group-of-mode mode)))
860    
861    
862    ;;;###autoload
863  (defun customize-group (group)  (defun customize-group (group)
864    "Customize GROUP, which must be a customization group."    "Customize GROUP, which must be a customization group."
865    (interactive (list (let ((completion-ignore-case t))    (interactive (list (let ((completion-ignore-case t))
# Line 855  are shown; the contents of those subgrou Line 873  are shown; the contents of those subgrou
873      (if (string-equal "" group)      (if (string-equal "" group)
874          (setq group 'emacs)          (setq group 'emacs)
875        (setq group (intern group))))        (setq group (intern group))))
   (or (get group 'custom-group)  
       (custom-load-symbol group))  
876    (let ((name (format "*Customize Group: %s*"    (let ((name (format "*Customize Group: %s*"
877                        (custom-unlispify-tag-name group))))                        (custom-unlispify-tag-name group))))
878      (if (get-buffer name)      (if (get-buffer name)
# Line 880  are shown; the contents of those subgrou Line 896  are shown; the contents of those subgrou
896      (if (string-equal "" group)      (if (string-equal "" group)
897          (setq group 'emacs)          (setq group 'emacs)
898        (setq group (intern group))))        (setq group (intern group))))
   (or (get group 'custom-group)  
       (custom-load-symbol group))  
899    (let ((name (format "*Customize Group: %s*"    (let ((name (format "*Customize Group: %s*"
900                        (custom-unlispify-tag-name group))))                        (custom-unlispify-tag-name group))))
901      (if (get-buffer name)      (if (get-buffer name)
902          (let ((window (selected-window)))          (let ((window (selected-window))
903                  ;; Copied from `custom-buffer-create-other-window'.
904                  (pop-up-windows t)
905                  (special-display-buffer-names nil)
906                  (special-display-regexps nil)
907                  (same-window-buffer-names nil)
908                  (same-window-regexps nil))
909            (pop-to-buffer name)            (pop-to-buffer name)
910            (select-window window))            (select-window window))
911        (custom-buffer-create-other-window        (custom-buffer-create-other-window
# Line 901  are shown; the contents of those subgrou Line 921  are shown; the contents of those subgrou
921  (defun customize-option (symbol)  (defun customize-option (symbol)
922    "Customize SYMBOL, which must be a user option variable."    "Customize SYMBOL, which must be a user option variable."
923    (interactive (custom-variable-prompt))    (interactive (custom-variable-prompt))
   ;; If we don't have SYMBOL's real definition loaded,  
   ;; try to load it.  
   (unless (get symbol 'custom-type)  
     (let ((loaddefs-file (locate-library "loaddefs.el" t))  
           file)  
       ;; See if it is autoloaded from some library.  
       (when loaddefs-file  
         (with-temp-buffer  
           (insert-file-contents loaddefs-file)  
           (when (re-search-forward (concat "^(defvar " (symbol-name symbol))  
                                    nil t)  
             (search-backward "\n;;; Generated autoloads from ")  
             (goto-char (match-end 0))  
             (setq file (buffer-substring (point)  
                                          (progn (end-of-line) (point)))))))  
       ;; If it is, load that library.  
       (when file  
         (when (string-match "\\.el\\'" file)  
           (setq file (substring file 0 (match-beginning 0))))  
         (load file))))  
   (unless (get symbol 'custom-type)  
     (error "Variable %s cannot be customized" symbol))  
924    (custom-buffer-create (list (list symbol 'custom-variable))    (custom-buffer-create (list (list symbol 'custom-variable))
925                          (format "*Customize Option: %s*"                          (format "*Customize Option: %s*"
926                                  (custom-unlispify-tag-name symbol))))                                  (custom-unlispify-tag-name symbol))))
927    
928    ;;;###autoload
929    (defalias 'customize-variable-other-window 'customize-option-other-window)
930    
931    ;;;###autoload
932    (defun customize-option-other-window (symbol)
933      "Customize SYMBOL, which must be a user option variable.
934    Show the buffer in another window, but don't select it."
935      (interactive (custom-variable-prompt))
936      (custom-buffer-create-other-window
937       (list (list symbol 'custom-variable))
938       (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
939    
940  (defvar customize-changed-options-previous-release "20.2"  (defvar customize-changed-options-previous-release "20.2"
941    "Version for `customize-changed-options' to refer back to by default.")    "Version for `customize-changed-options' to refer back to by default.")
942    
# Line 950  version." Line 960  version."
960        (signal 'wrong-type-argument (list 'numberp since-version))))        (signal 'wrong-type-argument (list 'numberp since-version))))
961    (unless since-version    (unless since-version
962      (setq since-version customize-changed-options-previous-release))      (setq since-version customize-changed-options-previous-release))
963    (let ((found nil)  
964          (versions nil))    ;; Load the information for versions since since-version.  We use
965      (mapatoms (lambda (symbol)    ;; custom-load-symbol for this.
966                  (and (or (boundp symbol)    (put 'custom-versions-load-alist 'custom-loads nil)
967                           ;; For variables not yet loaded.    (dolist (elt custom-versions-load-alist)
968                           (get symbol 'standard-value)      (if (customize-version-lessp since-version (car elt))
969                           ;; For groups the previous test fails, this one          (dolist (load (cdr elt))
970                           ;; could be used to determine if symbol is a            (custom-add-load 'custom-versions-load-alist load))))
971                           ;; group. Is there a better way for this?    (custom-load-symbol 'custom-versions-load-alist)
972                           (get symbol 'group-documentation))    (put 'custom-versions-load-alist 'custom-loads nil)
973                       (let ((version (get symbol 'custom-version)))  
974                         (and version    (let (found)
975                              (or (null since-version)      (mapatoms
976                                  (customize-version-lessp since-version version))       (lambda (symbol)
977                              (if (member version versions)         (let ((version (get symbol 'custom-version)))
978                                  t           (if version
979                                ;;; Collect all versions that we use.               (when (customize-version-lessp since-version version)
980                                (push version versions))))                 (if (or (get symbol 'custom-group)
981                       (setq found                         (get symbol 'group-documentation))
982                             ;; We have to set the right thing here,                     (push (list symbol 'custom-group) found))
983                             ;; depending if we have a group or a                 (if (custom-variable-p symbol)
984                             ;; variable.                     (push (list symbol 'custom-variable) found))
985                             (if (get  symbol 'group-documentation)                 (if (custom-facep symbol)
986                                 (cons (list symbol 'custom-group) found)                     (push (list symbol 'custom-face) found)))))))
987                               (cons (list symbol 'custom-variable) found))))))      (if found
988      (if (not found)          (custom-buffer-create (custom-sort-items found t 'first)
989          (error "No user option defaults have been changed since Emacs %s"                                "*Customize Changed Options*")
990                 since-version)        (error "No user option defaults have been changed since Emacs %s"
991        (let ((flist nil))               since-version))))
         (while versions  
           (push (copy-sequence  
                  (cdr (assoc (car versions)  custom-versions-load-alist)))  
                 flist)  
           (setq versions (cdr versions)))  
         (put 'custom-versions-load-alist 'custom-loads  
              ;; Get all the files that correspond to element from the  
              ;; VERSIONS list. This could use some simplification.  
              (apply 'nconc flist)))  
       ;; Because we set all the files needed to be loaded as a  
       ;; `custom-loads' property to `custom-versions-load-alist' this  
       ;; call will actually load them.  
       (custom-load-symbol 'custom-versions-load-alist)  
       ;; Clean up  
       (put 'custom-versions-load-alist 'custom-loads nil)  
       (custom-buffer-create (custom-sort-items found t 'first)  
                             "*Customize Changed Options*"))))  
992    
993  (defun customize-version-lessp (version1 version2)  (defun customize-version-lessp (version1 version2)
994    ;; Why are the versions strings, and given that they are, why aren't    ;; Why are the versions strings, and given that they are, why aren't
# Line 1019  version." Line 1012  version."
1012      (or (< major1 major2)      (or (< major1 major2)
1013          (and (= major1 major2)          (and (= major1 major2)
1014               (< minor1 minor2)))))               (< minor1 minor2)))))
     
 ;;;###autoload  
 (defalias 'customize-variable-other-window 'customize-option-other-window)  
   
 ;;;###autoload  
 (defun customize-option-other-window (symbol)  
   "Customize SYMBOL, which must be a user option variable.  
 Show the buffer in another window, but don't select it."  
   (interactive (custom-variable-prompt))  
   (custom-buffer-create-other-window  
    (list (list symbol 'custom-variable))  
    (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))  
1015    
1016  ;;;###autoload  ;;;###autoload
1017  (defun customize-face (&optional face)  (defun customize-face (&optional face)
# Line 1053  suggest to customized that face, if it's Line 1034  suggest to customized that face, if it's
1034                               t nil)                               t nil)
1035                              "*Customize Faces*")                              "*Customize Faces*")
1036      (unless (facep face)      (unless (facep face)
1037        (error "Invalid face %S"))        (error "Invalid face %S" face))
1038      (custom-buffer-create (list (list face 'custom-face))      (custom-buffer-create (list (list face 'custom-face))
1039                            (format "*Customize Face: %s*"                            (format "*Customize Face: %s*"
1040                                    (custom-unlispify-tag-name face)))))                                    (custom-unlispify-tag-name face)))))
# Line 1079  suggest to customized that face, if it's Line 1060  suggest to customized that face, if it's
1060          t nil)          t nil)
1061         "*Customize Faces*")         "*Customize Faces*")
1062      (unless (facep face)      (unless (facep face)
1063        (error "Invalid face %S"))        (error "Invalid face %S" face))
1064      (custom-buffer-create-other-window      (custom-buffer-create-other-window
1065       (list (list face 'custom-face))       (list (list face 'custom-face))
1066       (format "*Customize Face: %s*"       (format "*Customize Face: %s*"
# Line 1105  suggest to customized that face, if it's Line 1086  suggest to customized that face, if it's
1086                              "*Customize Customized*"))))                              "*Customize Customized*"))))
1087    
1088  ;;;###autoload  ;;;###autoload
1089    (defun customize-rogue ()
1090      "Customize all user variable modified outside customize."
1091      (interactive)
1092      (let ((found nil))
1093        (mapatoms (lambda (symbol)
1094                    (let ((cval (or (get symbol 'customized-value)
1095                                    (get symbol 'saved-value)
1096                                    (get symbol 'standard-value))))
1097                      (when (and cval       ;Declared with defcustom.
1098                                 (default-boundp symbol) ;Has a value.
1099                                 (not (equal (eval (car cval))
1100                                             ;; Which does not match customize.
1101                                             (default-value symbol))))
1102                        (push (list symbol 'custom-variable) found)))))
1103        (if (not found)
1104            (error "No rogue user options")
1105          (custom-buffer-create (custom-sort-items found t nil)
1106                                "*Customize Rogue*"))))
1107    ;;;###autoload
1108  (defun customize-saved ()  (defun customize-saved ()
1109    "Customize all already saved user options."    "Customize all already saved user options."
1110    (interactive)    (interactive)
# Line 1144  user-settable, as well as faces and grou Line 1144  user-settable, as well as faces and grou
1144                    (when (and (not (memq all '(groups faces)))                    (when (and (not (memq all '(groups faces)))
1145                               (boundp symbol)                               (boundp symbol)
1146                               (or (get symbol 'saved-value)                               (or (get symbol 'saved-value)
1147                                   (get symbol 'standard-value)                                   (custom-variable-p symbol)
1148                                   (if (memq all '(nil options))                                   (if (memq all '(nil options))
1149                                       (user-variable-p symbol)                                       (user-variable-p symbol)
1150                                     (get symbol 'variable-documentation))))                                     (get symbol 'variable-documentation))))
# Line 1425  item in another window.\n\n")) Line 1425  item in another window.\n\n"))
1425                     :custom-state 'unknown                     :custom-state 'unknown
1426                     :tag (custom-unlispify-tag-name group)                     :tag (custom-unlispify-tag-name group)
1427                     :value group))                     :value group))
1428      (widget-setup)
1429    (goto-char (point-min)))    (goto-char (point-min)))
1430    
1431  (define-widget 'custom-browse-visibility 'item  (define-widget 'custom-browse-visibility 'item
# Line 2051  If INITIAL-STRING is non-nil, use that r Line 2052  If INITIAL-STRING is non-nil, use that r
2052    :custom-save 'custom-variable-save    :custom-save 'custom-variable-save
2053    :custom-reset-current 'custom-redraw    :custom-reset-current 'custom-redraw
2054    :custom-reset-saved 'custom-variable-reset-saved    :custom-reset-saved 'custom-variable-reset-saved
2055    :custom-reset-standard 'custom-variable-reset-standard)    :custom-reset-standard 'custom-variable-reset-standard
2056      :custom-standard-value 'custom-variable-standard-value)
2057    
2058  (defun custom-variable-type (symbol)  (defun custom-variable-type (symbol)
2059    "Return a widget suitable for editing the value of SYMBOL.    "Return a widget suitable for editing the value of SYMBOL.
# Line 2119  Otherwise, look up symbol in `custom-gue Line 2121  Otherwise, look up symbol in `custom-gue
2121             (push (widget-create-child-and-convert             (push (widget-create-child-and-convert
2122                    widget 'visibility                    widget 'visibility
2123                    :help-echo "Show the value of this option."                    :help-echo "Show the value of this option."
2124                      :off "Show Value"
2125                    :action 'custom-toggle-parent                    :action 'custom-toggle-parent
2126                    nil)                    nil)
2127                   buttons))                   buttons))
# Line 2136  Otherwise, look up symbol in `custom-gue Line 2139  Otherwise, look up symbol in `custom-gue
2139               (push (widget-create-child-and-convert               (push (widget-create-child-and-convert
2140                      widget 'visibility                      widget 'visibility
2141                      :help-echo "Hide the value of this option."                      :help-echo "Hide the value of this option."
2142                        :on "Hide Value"
2143                        :off "Show Value"
2144                      :action 'custom-toggle-parent                      :action 'custom-toggle-parent
2145                      t)                      t)
2146                     buttons)                     buttons)
# Line 2170  Otherwise, look up symbol in `custom-gue Line 2175  Otherwise, look up symbol in `custom-gue
2175               (push (widget-create-child-and-convert               (push (widget-create-child-and-convert
2176                      widget 'visibility                      widget 'visibility
2177                      :help-echo "Hide the value of this option."                      :help-echo "Hide the value of this option."
2178                        :on "Hide Value"
2179                        :off "Show Value"
2180                      :action 'custom-toggle-parent                      :action 'custom-toggle-parent
2181                      t)                      t)
2182                     buttons)                     buttons)
# Line 2192  Otherwise, look up symbol in `custom-gue Line 2199  Otherwise, look up symbol in `custom-gue
2199        ;; this anyway. The doc string widget should be added like the others.        ;; this anyway. The doc string widget should be added like the others.
2200        ;; --dv        ;; --dv
2201        (widget-put widget :buttons buttons)        (widget-put widget :buttons buttons)
2202          (insert "\n")
2203        ;; Insert documentation.        ;; Insert documentation.
2204        (widget-default-format-handler widget ?h)        (widget-default-format-handler widget ?h)
2205    
# Line 2269  Otherwise, look up symbol in `custom-gue Line 2277  Otherwise, look up symbol in `custom-gue
2277                        (t 'rogue))))                        (t 'rogue))))
2278      (widget-put widget :custom-state state)))      (widget-put widget :custom-state state)))
2279    
2280    (defun custom-variable-standard-value (widget)
2281      (get (widget-value widget) 'standard-value))
2282    
2283  (defvar custom-variable-menu  (defvar custom-variable-menu
2284    '(("Set for Current Session" custom-variable-set    '(("Set for Current Session" custom-variable-set
2285       (lambda (widget)       (lambda (widget)
# Line 2291  Otherwise, look up symbol in `custom-gue Line 2302  Otherwise, look up symbol in `custom-gue
2302         (and (get (widget-value widget) 'standard-value)         (and (get (widget-value widget) 'standard-value)
2303              (memq (widget-get widget :custom-state)              (memq (widget-get widget :custom-state)
2304                    '(modified set changed saved rogue)))))                    '(modified set changed saved rogue)))))
2305        ("Use Backup Value" custom-variable-reset-backup
2306         (lambda (widget)
2307           (get (widget-value widget) 'backup-value)))
2308      ("---" ignore ignore)      ("---" ignore ignore)
2309      ("Add Comment" custom-comment-show custom-comment-invisible-p)      ("Add Comment" custom-comment-show custom-comment-invisible-p)
2310      ("---" ignore ignore)      ("---" ignore ignore)
# Line 2357  Optional EVENT is the location for the m Line 2371  Optional EVENT is the location for the m
2371               (setq comment nil)               (setq comment nil)
2372               ;; Make the comment invisible by hand if it's empty               ;; Make the comment invisible by hand if it's empty
2373               (custom-comment-hide comment-widget))               (custom-comment-hide comment-widget))
2374               (custom-variable-backup-value widget)
2375             (funcall set symbol (eval (setq val (widget-value child))))             (funcall set symbol (eval (setq val (widget-value child))))
2376             (put symbol 'customized-value (list val))             (put symbol 'customized-value (list val))
2377             (put symbol 'variable-comment comment)             (put symbol 'variable-comment comment)
# Line 2366  Optional EVENT is the location for the m Line 2381  Optional EVENT is the location for the m
2381               (setq comment nil)               (setq comment nil)
2382               ;; Make the comment invisible by hand if it's empty               ;; Make the comment invisible by hand if it's empty
2383               (custom-comment-hide comment-widget))               (custom-comment-hide comment-widget))
2384               (custom-variable-backup-value widget)
2385             (funcall set symbol (setq val (widget-value child)))             (funcall set symbol (setq val (widget-value child)))
2386             (put symbol 'customized-value (list (custom-quote val)))             (put symbol 'customized-value (list (custom-quote val)))
2387             (put symbol 'variable-comment comment)             (put symbol 'variable-comment comment)
# Line 2394  Optional EVENT is the location for the m Line 2410  Optional EVENT is the location for the m
2410               ;; Make the comment invisible by hand if it's empty               ;; Make the comment invisible by hand if it's empty
2411               (custom-comment-hide comment-widget))               (custom-comment-hide comment-widget))
2412             (put symbol 'saved-value (list (widget-value child)))             (put symbol 'saved-value (list (widget-value child)))
2413               (custom-push-theme 'theme-value symbol 'user
2414                                  'set (list (widget-value child)))
2415             (funcall set symbol (eval (widget-value child)))             (funcall set symbol (eval (widget-value child)))
2416             (put symbol 'variable-comment comment)             (put symbol 'variable-comment comment)
2417             (put symbol 'saved-variable-comment comment))             (put symbol 'saved-variable-comment comment))
# Line 2404  Optional EVENT is the location for the m Line 2422  Optional EVENT is the location for the m
2422               (custom-comment-hide comment-widget))               (custom-comment-hide comment-widget))
2423             (put symbol 'saved-value             (put symbol 'saved-value
2424                  (list (custom-quote (widget-value child))))                  (list (custom-quote (widget-value child))))
2425               (custom-push-theme 'theme-value symbol 'user
2426                                  'set (list (custom-quote (widget-value
2427                                                      child))))
2428             (funcall set symbol (widget-value child))             (funcall set symbol (widget-value child))
2429             (put symbol 'variable-comment comment)             (put symbol 'variable-comment comment)
2430             (put symbol 'saved-variable-comment comment)))             (put symbol 'saved-variable-comment comment)))
# Line 2414  Optional EVENT is the location for the m Line 2435  Optional EVENT is the location for the m
2435      (custom-redraw-magic widget)))      (custom-redraw-magic widget)))
2436    
2437  (defun custom-variable-reset-saved (widget)  (defun custom-variable-reset-saved (widget)
2438    "Restore the saved value for the variable being edited by WIDGET."    "Restore the saved value for the variable being edited by WIDGET.
2439    The value that was current before this operation
2440    becomes the backup value, so you can get it again."
2441    (let* ((symbol (widget-value widget))    (let* ((symbol (widget-value widget))
2442           (set (or (get symbol 'custom-set) 'set-default))           (set (or (get symbol 'custom-set) 'set-default))
2443             (comment-widget (widget-get widget :comment-widget))
2444           (value (get symbol 'saved-value))           (value (get symbol 'saved-value))
2445           (comment (get symbol 'saved-variable-comment)))           (comment (get symbol 'saved-variable-comment)))
2446      (cond ((or value comment)      (cond ((or value comment)
2447             (put symbol 'variable-comment comment)             (put symbol 'variable-comment comment)
2448               (custom-variable-backup-value widget)
2449             (condition-case nil             (condition-case nil
2450                 (funcall set symbol (eval (car value)))                 (funcall set symbol (eval (car value)))
2451               (error nil)))               (error nil)))
# Line 2435  Optional EVENT is the location for the m Line 2460  Optional EVENT is the location for the m
2460  (defun custom-variable-reset-standard (widget)  (defun custom-variable-reset-standard (widget)
2461    "Restore the standard setting for the variable being edited by WIDGET.    "Restore the standard setting for the variable being edited by WIDGET.
2462  This operation eliminates any saved setting for the variable,  This operation eliminates any saved setting for the variable,
2463  restoring it to the state of a variable that has never been customized."  restoring it to the state of a variable that has never been customized.
2464    The value that was current before this operation
2465    becomes the backup value, so you can get it again."
2466    (let* ((symbol (widget-value widget))    (let* ((symbol (widget-value widget))
2467           (set (or (get symbol 'custom-set) 'set-default)))           (set (or (get symbol 'custom-set) 'set-default))
2468             (comment-widget (widget-get widget :comment-widget)))
2469      (if (get symbol 'standard-value)      (if (get symbol 'standard-value)
2470          (funcall set symbol (eval (car (get symbol 'standard-value))))          (progn
2471              (custom-variable-backup-value widget)
2472              (funcall set symbol (eval (car (get symbol 'standard-value)))))
2473        (error "No standard setting known for %S" symbol))        (error "No standard setting known for %S" symbol))
2474      (put symbol 'variable-comment nil)      (put symbol 'variable-comment nil)
2475      (put symbol 'customized-value nil)      (put symbol 'customized-value nil)
2476      (put symbol 'customized-variable-comment nil)      (put symbol 'customized-variable-comment nil)
2477      (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))      (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
2478        (put symbol 'saved-value nil)        (put symbol 'saved-value nil)
2479          (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
2480          ;; As a special optimizations we do not (explictly)
2481          ;; save resets to standard when no theme set the value.
2482          (if (null (cdr (get symbol 'theme-value)))
2483              (put symbol 'theme-value nil))
2484        (put symbol 'saved-variable-comment nil)        (put symbol 'saved-variable-comment nil)
2485        (custom-save-all))        (custom-save-all))
2486      (widget-put widget :custom-state 'unknown)      (widget-put widget :custom-state 'unknown)
2487      ;; This call will possibly make the comment invisible      ;; This call will possibly make the comment invisible
2488      (custom-redraw widget)))      (custom-redraw widget)))
2489    
2490    (defun custom-variable-backup-value (widget)
2491      "Back up the current value for WIDGET's variable.
2492    The backup value is kept in the car of the `backup-value' property."
2493      (let* ((symbol (widget-value widget))
2494             (get (or (get symbol 'custom-get) 'default-value))
2495             (type (custom-variable-type symbol))
2496             (conv (widget-convert type))
2497             (value (if (default-boundp symbol)
2498                        (funcall get symbol)
2499                      (widget-get conv :value))))
2500        (put symbol 'backup-value (list value))))
2501    
2502    (defun custom-variable-reset-backup (widget)
2503      "Restore the backup value for the variable being edited by WIDGET.
2504    The value that was current before this operation
2505    becomes the backup value, so you can use this operation repeatedly
2506    to switch between two values."
2507      (let* ((symbol (widget-value widget))
2508             (set (or (get symbol 'custom-set) 'set-default))
2509             (value (get symbol 'backup-value))
2510             (comment-widget (widget-get widget :comment-widget))
2511             (comment (widget-value comment-widget)))
2512        (if value
2513            (progn
2514              (custom-variable-backup-value widget)
2515              (condition-case nil
2516                  (funcall set symbol (car value))
2517                 (error nil)))
2518          (error "No backup value for %s" symbol))
2519        (put symbol 'customized-value (list (car value)))
2520        (put symbol 'variable-comment comment)
2521        (put symbol 'customized-variable-comment comment)
2522        (custom-variable-state-set widget)
2523        ;; This call will possibly make the comment invisible
2524        (custom-redraw widget)))
2525    
2526  ;;; The `custom-face-edit' Widget.  ;;; The `custom-face-edit' Widget.
2527    
2528  (define-widget 'custom-face-edit 'checklist  (define-widget 'custom-face-edit 'checklist
# Line 2462  restoring it to the state of a variable Line 2533  restoring it to the state of a variable
2533    :button-args '(:help-echo "Control whether this attribute has any effect.")    :button-args '(:help-echo "Control whether this attribute has any effect.")
2534    :value-to-internal 'custom-face-edit-fix-value    :value-to-internal 'custom-face-edit-fix-value
2535    :match (lambda (widget value)    :match (lambda (widget value)
2536             (widget-checklist-match widget             (widget-checklist-match widget
2537                                     (custom-face-edit-fix-value widget value)))                                     (custom-face-edit-fix-value widget value)))
2538    :convert-widget 'custom-face-edit-convert-widget    :convert-widget 'custom-face-edit-convert-widget
2539    :args (mapcar (lambda (att)    :args (mapcar (lambda (att)
# Line 2474  restoring it to the state of a variable Line 2545  restoring it to the state of a variable
2545                  custom-face-attributes))                  custom-face-attributes))
2546    
2547  (defun custom-face-edit-fix-value (widget value)  (defun custom-face-edit-fix-value (widget value)
2548    "Ignoring WIDGET, convert :bold and :italic in VALUE to new form."    "Ignoring WIDGET, convert :bold and :italic in VALUE to new form.
2549    (let (result)  Also change :reverse-video to :inverse-video."
2550      (while value    (if (listp value)
2551        (let ((key (car value))        (let (result)
2552              (val (car (cdr value))))          (while value
2553          (cond ((eq key :italic)            (let ((key (car value))
2554                 (push :slant result)                  (val (car (cdr value))))
2555                 (push (if val 'italic 'normal) result))              (cond ((eq key :italic)
2556                ((eq key :bold)                     (push :slant result)
2557                 (push :weight result)                     (push (if val 'italic 'normal) result))
2558                 (push (if val 'bold 'normal) result))                    ((eq key :bold)
2559                (t                     (push :weight result)
2560                 (push key result)                     (push (if val 'bold 'normal) result))
2561                 (push val result))))                    ((eq key :reverse-video)
2562        (setq value (cdr (cdr value))))                     (push :inverse-video result)
2563      (setq result (nreverse result))                     (push val result))
2564      result))                    (t
2565                       (push key result)
2566                       (push val result))))
2567              (setq value (cdr (cdr value))))
2568            (setq result (nreverse result))
2569            result)
2570        value))
2571    
2572  (defun custom-face-edit-convert-widget (widget)  (defun custom-face-edit-convert-widget (widget)
2573    "Convert :args as widget types in WIDGET."    "Convert :args as widget types in WIDGET."
# Line 2547  restoring it to the state of a variable Line 2624  restoring it to the state of a variable
2624        (delete-region (car (cdr inactive))        (delete-region (car (cdr inactive))
2625                       (+ (car (cdr inactive)) (cdr (cdr inactive))))                       (+ (car (cdr inactive)) (cdr (cdr inactive))))
2626        (widget-put widget :inactive nil))))        (widget-put widget :inactive nil))))
2627          
2628    
2629  (defun custom-face-edit-attribute-tag (widget)  (defun custom-face-edit-attribute-tag (widget)
2630    "Returns the first :tag property in WIDGET or one of its children."    "Returns the first :tag property in WIDGET or one of its children."
# Line 2587  OS/2 Presentation Manager.") Line 2664  OS/2 Presentation Manager.")
2664                                             :sibling-args (:help-echo "\                                             :sibling-args (:help-echo "\
2665  Windows NT/9X.")  Windows NT/9X.")
2666                                             w32)                                             w32)
2667                                        (const :format "MAC "
2668                                               :sibling-args (:help-echo "\
2669    Macintosh OS.")
2670                                               mac)
2671                                      (const :format "DOS "                                      (const :format "DOS "
2672                                             :sibling-args (:help-echo "\                                             :sibling-args (:help-echo "\
2673  Plain MS-DOS.")  Plain MS-DOS.")
# Line 2662  Only match frames that support the speci Line 2743  Only match frames that support the speci
2743    :custom-reset-current 'custom-redraw    :custom-reset-current 'custom-redraw
2744    :custom-reset-saved 'custom-face-reset-saved    :custom-reset-saved 'custom-face-reset-saved
2745    :custom-reset-standard 'custom-face-reset-standard    :custom-reset-standard 'custom-face-reset-standard
2746      :custom-standard-value 'custom-face-standard-value
2747    :custom-menu 'custom-face-menu-create)    :custom-menu 'custom-face-menu-create)
2748    
2749  (define-widget 'custom-face-all 'editable-list  (define-widget 'custom-face-all 'editable-list
# Line 2776  SPEC must be a full face spec." Line 2858  SPEC must be a full face spec."
2858             (push (widget-create-child-and-convert             (push (widget-create-child-and-convert
2859                    widget 'visibility                    widget 'visibility
2860                    :help-echo "Hide or show this face."                    :help-echo "Hide or show this face."
2861                      :on "Hide Face"
2862                      :off "Show Face"
2863                    :action 'custom-toggle-parent                    :action 'custom-toggle-parent
2864                    (not (eq state 'hidden)))                    (not (eq state 'hidden)))
2865                   buttons)                   buttons)
# Line 2979  Optional EVENT is the location for the m Line 3063  Optional EVENT is the location for the m
3063        ;; face-set-spec ignores empty attribute lists, so just give it        ;; face-set-spec ignores empty attribute lists, so just give it
3064        ;; something harmless instead.        ;; something harmless instead.
3065        (face-spec-set symbol '((t :foreground unspecified))))        (face-spec-set symbol '((t :foreground unspecified))))
3066      (put symbol 'saved-face value)      (unless (eq (widget-get widget :custom-state) 'standard)
3067          (put symbol 'saved-face value))
3068        (custom-push-theme 'theme-face symbol 'user 'set value)
3069      (put symbol 'customized-face nil)      (put symbol 'customized-face nil)
3070      (put symbol 'face-comment comment)      (put symbol 'face-comment comment)
3071      (put symbol 'customized-face-comment nil)      (put symbol 'customized-face-comment nil)
# Line 3007  Optional EVENT is the location for the m Line 3093  Optional EVENT is the location for the m
3093      (custom-face-state-set widget)      (custom-face-state-set widget)
3094      (custom-redraw-magic widget)))      (custom-redraw-magic widget)))
3095    
3096    (defun custom-face-standard-value (widget)
3097      (get (widget-value widget) 'face-defface-spec))
3098    
3099  (defun custom-face-reset-standard (widget)  (defun custom-face-reset-standard (widget)
3100    "Restore WIDGET to the face's standard settings.    "Restore WIDGET to the face's standard settings.
3101  This operation eliminates any saved setting for the face,  This operation eliminates any saved setting for the face,
# Line 3021  restoring it to the state of a face that Line 3110  restoring it to the state of a face that
3110      (put symbol 'customized-face-comment nil)      (put symbol 'customized-face-comment nil)
3111      (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))      (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
3112        (put symbol 'saved-face nil)        (put symbol 'saved-face nil)
3113          (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
3114          ;; Do not explictly save resets to standards without themes.
3115          (if (null (cdr (get symbol 'theme-face)))
3116              (put symbol  'theme-face nil))
3117        (put symbol 'saved-face-comment nil)        (put symbol 'saved-face-comment nil)
3118        (custom-save-all))        (custom-save-all))
3119      (face-spec-set symbol value)      (face-spec-set symbol value)
# Line 3207  If GROUPS-ONLY non-nil, return only thos Line 3300  If GROUPS-ONLY non-nil, return only thos
3300    
3301  (defun custom-group-value-create (widget)  (defun custom-group-value-create (widget)
3302    "Insert a customize group for WIDGET in the current buffer."    "Insert a customize group for WIDGET in the current buffer."
3303      (unless (eq (widget-get widget :custom-state) 'hidden)
3304        (custom-load-widget widget))
3305    (let* ((state (widget-get widget :custom-state))    (let* ((state (widget-get widget :custom-state))
3306           (level (widget-get widget :custom-level))           (level (widget-get widget :custom-level))
3307           ;; (indent (widget-get widget :indent))           ;; (indent (widget-get widget :indent))
# Line 3246  If GROUPS-ONLY non-nil, return only thos Line 3341  If GROUPS-ONLY non-nil, return only thos
3341             (widget-put widget :buttons buttons))             (widget-put widget :buttons buttons))
3342            ((eq custom-buffer-style 'tree)            ((eq custom-buffer-style 'tree)
3343             (custom-browse-insert-prefix prefix)             (custom-browse-insert-prefix prefix)
            (custom-load-widget widget)  
3344             (if (zerop (length members))             (if (zerop (length members))
3345                 (progn                 (progn
3346                   (custom-browse-insert-prefix prefix)                   (custom-browse-insert-prefix prefix)
# Line 3387  If GROUPS-ONLY non-nil, return only thos Line 3481  If GROUPS-ONLY non-nil, return only thos
3481                                               ?\ ))                                               ?\ ))
3482             ;; Members.             ;; Members.
3483             (message "Creating group...")             (message "Creating group...")
            (custom-load-widget widget)  
3484             (let* ((members (custom-sort-items members             (let* ((members (custom-sort-items members
3485                                                custom-buffer-sort-alphabetically                                                custom-buffer-sort-alphabetically
3486                                                custom-buffer-order-groups))                                                custom-buffer-order-groups))
# Line 3561  to the new custom file.  This will prese Line 3654  to the new custom file.  This will prese
3654    "Visit `custom-file' and delete all calls to SYMBOL from it.    "Visit `custom-file' and delete all calls to SYMBOL from it.
3655  Leave point at the old location of the first such call,  Leave point at the old location of the first such call,
3656  or (if there were none) at the end of the buffer."  or (if there were none) at the end of the buffer."
3657    (let ((default-major-mode))    (let ((default-major-mode 'emacs-lisp-mode))
3658      (set-buffer (find-file-noselect (custom-file))))      (set-buffer (find-file-noselect (custom-file))))
3659    (goto-char (point-min))    (goto-char (point-min))
3660    ;; Skip all whitespace and comments.    ;; Skip all whitespace and comments.
# Line 3599  or (if there were none) at the end of th Line 3692  or (if there were none) at the end of th
3692  (defun custom-save-variables ()  (defun custom-save-variables ()
3693    "Save all customized variables in `custom-file'."    "Save all customized variables in `custom-file'."
3694    (save-excursion    (save-excursion
3695        (custom-save-delete 'custom-load-themes)
3696        (custom-save-delete 'custom-reset-variables)
3697      (custom-save-delete 'custom-set-variables)      (custom-save-delete 'custom-set-variables)
3698        (custom-save-loaded-themes)
3699        (custom-save-resets 'theme-value 'custom-reset-variables nil)
3700      (let ((standard-output (current-buffer))      (let ((standard-output (current-buffer))
3701            (saved-list (make-list 1 0))            (saved-list (make-list 1 0))
3702            sort-fold-case)            sort-fold-case)
# Line 3612  or (if there were none) at the end of th Line 3709  or (if there were none) at the end of th
3709        (unless (bolp)        (unless (bolp)
3710          (princ "\n"))          (princ "\n"))
3711        (princ "(custom-set-variables        (princ "(custom-set-variables
3712    ;; custom-set-variables was added by Custom -- don't edit or cut/paste it!    ;; custom-set-variables was added by Custom.
3713    ;; Your init file should contain only one such instance.\n")    ;; If you edit it by hand, you could mess it up, so be careful.
3714        (mapcar    ;; Your init file should contain only one such instance.
3715         (lambda (symbol)    ;; If there is more than one, they won't work right.\n")
3716           (let ((value (get symbol 'saved-value))        (dolist (symbol saved-list)
3717                 (requests (get symbol 'custom-requests))          (let ((spec (car-safe (get symbol 'theme-value)))
3718                 (now (not (or (get symbol 'standard-value)                (value (get symbol 'saved-value))
3719                               (and (not (boundp symbol))                (requests (get symbol 'custom-requests))
3720                                    (not (get symbol 'force-value))))))                (now (not (or (custom-variable-p symbol)
3721                 (comment (get symbol 'saved-variable-comment))                              (and (not (boundp symbol))
3722                 sep)                                   (not (eq (get symbol 'force-value)
3723             (when (or value comment)                                            'rogue))))))
3724               (unless (bolp)                (comment (get symbol 'saved-variable-comment))
3725                 (princ "\n"))                sep)
3726               (princ " '(")            ;; Check `requests'.
3727               (prin1 symbol)            (dolist (request requests)
3728               (princ " ")              (when (and (symbolp request) (not (featurep request)))
3729               (prin1 (car value))                (message "Unknown requested feature: %s" request)
3730               (cond ((or now requests comment)                (setq requests (delq request requests))))
3731                      (princ " ")            (when (or (and spec
3732                      (if now                           (eq (nth 0 spec) 'user)
3733                          (princ "t")                           (eq (nth 1 spec) 'set))
3734                        (princ "nil"))                      comment
3735                      (cond ((or requests comment)                      (and (null spec) (get symbol 'saved-value)))
3736                             (princ " ")              (unless (bolp)
3737                             (if requests                (princ "\n"))
3738                                 (prin1 requests)              (princ " '(")
3739                               (princ "nil"))              (prin1 symbol)
3740                             (cond (comment              (princ " ")
3741                                    (princ " ")              (prin1 (car value))
3742                                    (prin1 comment)              (when (or now requests comment)
3743                                    (princ ")"))                (princ " ")
3744                                   (t                (prin1 now)
3745                                    (princ ")"))))                (when (or requests comment)
3746                            (t                  (princ " ")
3747                             (princ ")"))))                  (prin1 requests)
3748                     (t                  (when comment
3749                      (princ ")"))))))                    (princ " ")
3750         saved-list)                    (prin1 comment))))
3751                (princ ")"))))
3752        (if (bolp)        (if (bolp)
3753            (princ " "))            (princ " "))
3754        (princ ")")        (princ ")")
# Line 3660  or (if there were none) at the end of th Line 3758  or (if there were none) at the end of th
3758  (defun custom-save-faces ()  (defun custom-save-faces ()
3759    "Save all customized faces in `custom-file'."    "Save all customized faces in `custom-file'."
3760    (save-excursion    (save-excursion
3761        (custom-save-delete 'custom-reset-faces)
3762      (custom-save-delete 'custom-set-faces)      (custom-save-delete 'custom-set-faces)
3763        (custom-save-resets 'theme-face 'custom-reset-faces '(default))
3764      (let ((standard-output (current-buffer))      (let ((standard-output (current-buffer))
3765            (saved-list (make-list 1 0))            (saved-list (make-list 1 0))
3766            sort-fold-case)            sort-fold-case)
# Line 3676  or (if there were none) at the end of th Line 3776  or (if there were none) at the end of th
3776        (unless (bolp)        (unless (bolp)
3777          (princ "\n"))          (princ "\n"))
3778        (princ "(custom-set-faces        (princ "(custom-set-faces
3779    ;; custom-set-faces was added by Custom -- don't edit or cut/paste it!    ;; custom-set-faces was added by Custom.
3780    ;; Your init file should contain only one such instance.\n")    ;; If you edit it by hand, you could mess it up, so be careful.
3781        (mapcar    ;; Your init file should contain only one such instance.
3782         (lambda (symbol)    ;; If there is more than one, they won't work right.\n")
3783           (let ((value (get symbol 'saved-face))        (dolist (symbol saved-list)
3784                 (now (not (or (get 'default 'face-defface-spec)          (let ((spec (car-safe (get symbol 'theme-face)))
3785                               (and (not (custom-facep 'default))                (value (get symbol 'saved-face))
3786                                    (not (get 'default 'force-face))))))                (now (not (or (get symbol 'face-defface-spec)
3787                 (comment (get 'default 'saved-face-comment)))                              (and (not (custom-facep symbol))
3788             (unless (eq symbol 'default))                                   (not (get symbol 'force-face))))))
3789             ;; Don't print default face here.                (comment (get symbol 'saved-face-comment)))
3790             (unless (bolp)            (when (or (and spec
3791               (princ "\n"))                           (eq (nth 0 spec) 'user)
3792             (princ " '(")                           (eq (nth 1 spec) 'set))
3793             (prin1 symbol)                      comment
3794             (princ " ")                      (and (null spec) (get symbol 'saved-face)))
3795             (prin1 value)              ;; Don't print default face here.
3796             (cond ((or now comment)              (unless (bolp)
3797                    (princ " ")                (princ "\n"))
3798                    (if now              (princ " '(")
3799                        (princ "t")              (prin1 symbol)
3800                      (princ "nil"))              (princ " ")
3801                    (cond (comment              (prin1 value)
3802                           (princ " ")              (when (or now comment)
3803                           (prin1 comment)                (princ " ")
3804                           (princ ")"))                (prin1 now)
3805                          (t                (when comment
3806                           (princ ")"))))                  (princ " ")
3807                   (t                  (prin1 comment)))
3808                    (princ ")")))))              (princ ")"))))
        saved-list)  
3809        (if (bolp)        (if (bolp)
3810            (princ " "))            (princ " "))
3811        (princ ")")        (princ ")")
3812        (unless (looking-at "\n")        (unless (looking-at "\n")
3813          (princ "\n")))))          (princ "\n")))))
3814    
3815    (defun custom-save-resets (property setter special)
3816      (let (started-writing ignored-special)
3817        ;; (custom-save-delete setter) Done by caller
3818        (let ((standard-output (current-buffer))
3819              (mapper `(lambda (object)
3820                        (let ((spec (car-safe (get object (quote ,property)))))
3821                          (when (and (not (memq object ignored-special))
3822                                     (eq (nth 0 spec) 'user)
3823                                     (eq (nth 1 spec) 'reset))
3824                            ;; Do not write reset statements unless necessary.
3825                            (unless started-writing
3826                              (setq started-writing t)
3827                              (unless (bolp)
3828                                (princ "\n"))
3829                            (princ "(")
3830                            (princ (quote ,setter))
3831                            (princ "\n '(")
3832                            (prin1 object)
3833                            (princ " ")
3834                            (prin1 (nth 3 spec))
3835                            (princ ")")))))))
3836          (mapc mapper special)
3837          (setq ignored-special special)
3838          (mapatoms mapper)
3839          (when started-writing
3840            (princ ")\n")))))
3841    
3842    (defun custom-save-loaded-themes ()
3843      (let ((themes (reverse (get 'user 'theme-loads-themes)))
3844            (standard-output (current-buffer)))
3845        (when themes
3846          (unless (bolp) (princ "\n"))
3847          (princ "(custom-load-themes")
3848          (mapc (lambda (theme)
3849                  (princ "\n   '")
3850                  (prin1 theme)) themes)
3851          (princ " )\n"))))
3852    
3853  ;;;###autoload  ;;;###autoload
3854  (defun customize-save-customized ()  (defun customize-save-customized ()
3855    "Save all user options which have been set in this session."    "Save all user options which have been set in this session."
# Line 3725  or (if there were none) at the end of th Line 3862  or (if there were none) at the end of th
3862                       (get symbol 'customized-variable-comment)))                       (get symbol 'customized-variable-comment)))
3863                  (when face                  (when face
3864                    (put symbol 'saved-face face)                    (put symbol 'saved-face face)
3865                      (custom-push-theme 'theme-face symbol 'user 'set value)
3866                    (put symbol 'customized-face nil))                    (put symbol 'customized-face nil))
3867                  (when value                  (when value
3868                    (put symbol 'saved-value value)                    (put symbol 'saved-value value)
3869                      (custom-push-theme 'theme-value symbol 'user 'set value)
3870                    (put symbol 'customized-value nil))                    (put symbol 'customized-value nil))
3871                  (when variable-comment                  (when variable-comment
3872                    (put symbol 'saved-variable-comment variable-comment)                    (put symbol 'saved-variable-comment variable-comment)
# Line 3788  or (if there were none) at the end of th Line 3927  or (if there were none) at the end of th
3927    "Ignoring WIDGET, create a menu entry for customization group SYMBOL."    "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
3928    `( ,(custom-unlispify-menu-entry symbol t)    `( ,(custom-unlispify-menu-entry symbol t)
3929       :filter (lambda (&rest junk)       :filter (lambda (&rest junk)
3930                 (cdr (custom-menu-create ',symbol)))))                 (let ((menu (custom-menu-create ',symbol)))
3931                     (if (consp menu) (cdr menu) menu)))))
3932    
3933  ;;;###autoload  ;;;###autoload
3934  (defun custom-menu-create (symbol)  (defun custom-menu-create (symbol)
# Line 3799  The menu is in a format applicable to `e Line 3939  The menu is in a format applicable to `e
3939                         t)))                         t)))
3940      (if (and (or (not (boundp 'custom-menu-nesting))      (if (and (or (not (boundp 'custom-menu-nesting))
3941                   (>= custom-menu-nesting 0))                   (>= custom-menu-nesting 0))
3942               (< (length (get symbol 'custom-group)) widget-menu-max-size))               (progn
3943                   (custom-load-symbol symbol)
3944                   (< (length (get symbol 'custom-group)) widget-menu-max-size)))
3945          (let ((custom-prefix-list (custom-prefix-add symbol          (let ((custom-prefix-list (custom-prefix-add symbol
3946                                                       custom-prefix-list))                                                       custom-prefix-list))
3947                (members (custom-sort-items (get symbol 'custom-group)                (members (custom-sort-items (get symbol 'custom-group)
3948                                            custom-menu-sort-alphabetically                                            custom-menu-sort-alphabetically
3949                                            custom-menu-order-groups)))                                            custom-menu-order-groups)))
           (custom-load-symbol symbol)  
3950            `(,(custom-unlispify-menu-entry symbol t)            `(,(custom-unlispify-menu-entry symbol t)
3951              ,item              ,item
3952              "--"              "--"
# Line 3827  The format is suitable for use with `eas Line 3968  The format is suitable for use with `eas
3968      (setq name "Customize"))      (setq name "Customize"))
3969    `(,name    `(,name
3970      :filter (lambda (&rest junk)      :filter (lambda (&rest junk)
3971                (custom-menu-create ',symbol))))                (let ((menu (custom-menu-create ',symbol)))
3972                    (if (consp menu) (cdr menu) menu)))))
3973    
3974  ;;; The Custom Mode.  ;;; The Custom Mode.
3975    
# Line 3916  if that value is non-nil." Line 4058  if that value is non-nil."
4058    (use-local-map custom-mode-map)    (use-local-map custom-mode-map)
4059    (easy-menu-add Custom-mode-menu)    (easy-menu-add Custom-mode-menu)
4060    (make-local-variable 'custom-options)    (make-local-variable 'custom-options)
4061      (make-local-variable 'custom-local-buffer)
4062    (make-local-variable 'widget-documentation-face)    (make-local-variable 'widget-documentation-face)
4063    (setq widget-documentation-face 'custom-documentation-face)    (setq widget-documentation-face 'custom-documentation-face)
4064    (make-local-variable 'widget-button-face)    (make-local-variable 'widget-button-face)

Legend:
Removed from v.1.157  
changed lines
  Added in v.1.157.2.1

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