Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 422:95016f13131a r21-2-19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-19
author cvs
date Mon, 13 Aug 2007 11:25:01 +0200
parents ebe98a74bd68
children 11054d720c21
comparison
equal deleted inserted replaced
421:fff06e11db74 422:95016f13131a
615 children))) 615 children)))
616 616
617 617
618 ;;; The Customize Commands 618 ;;; The Customize Commands
619 619
620 (defun custom-prompt-variable (prompt-var prompt-val) 620 (defun custom-prompt-variable (prompt-var prompt-val &optional comment)
621 "Prompt for a variable and a value and return them as a list. 621 "Prompt for a variable and a value and return them as a list.
622 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the 622 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
623 prompt for the value. The %s escape in PROMPT-VAL is replaced with 623 prompt for the value. The %s escape in PROMPT-VAL is replaced with
624 the name of the variable. 624 the name of the variable.
625 625
626 If the variable has a `variable-interactive' property, that is used as if 626 If the variable has a `variable-interactive' property, that is used as if
627 it were the arg to `interactive' (which see) to interactively read the value. 627 it were the arg to `interactive' (which see) to interactively read the value.
628 628
629 If the variable has a `custom-type' property, it must be a widget and the 629 If the variable has a `custom-type' property, it must be a widget and the
630 `:prompt-value' property of that widget will be used for reading the value." 630 `:prompt-value' property of that widget will be used for reading the value.
631
632 If optional COMMENT argument is non nil, also prompt for a comment and return
633 it as the third element in the list."
631 (let* ((var (read-variable prompt-var)) 634 (let* ((var (read-variable prompt-var))
632 (minibuffer-help-form '(describe-variable var))) 635 (minibuffer-help-form '(describe-variable var))
633 (list var 636 (val
634 (let ((prop (get var 'variable-interactive)) 637 (let ((prop (get var 'variable-interactive))
635 (type (get var 'custom-type)) 638 (type (get var 'custom-type))
636 (prompt (format prompt-val var))) 639 (prompt (format prompt-val var)))
637 (unless (listp type) 640 (unless (listp type)
638 (setq type (list type))) 641 (setq type (list type)))
647 prompt 650 prompt
648 (if (boundp var) 651 (if (boundp var)
649 (symbol-value var)) 652 (symbol-value var))
650 (not (boundp var)))) 653 (not (boundp var))))
651 (t 654 (t
652 (eval-minibuffer prompt))))))) 655 (eval-minibuffer prompt))))))
656 (if comment
657 (list var val
658 (read-string "Comment: " (get var 'variable-comment)))
659 (list var val))
660 ))
653 661
654 ;;;###autoload 662 ;;;###autoload
655 (defun customize-set-value (var val) 663 (defun customize-set-value (var val &optional comment)
656 "Set VARIABLE to VALUE. VALUE is a Lisp object. 664 "Set VARIABLE to VALUE. VALUE is a Lisp object.
657 665
658 If VARIABLE has a `variable-interactive' property, that is used as if 666 If VARIABLE has a `variable-interactive' property, that is used as if
659 it were the arg to `interactive' (which see) to interactively read the value. 667 it were the arg to `interactive' (which see) to interactively read the value.
660 668
661 If VARIABLE has a `custom-type' property, it must be a widget and the 669 If VARIABLE has a `custom-type' property, it must be a widget and the
662 `:prompt-value' property of that widget will be used for reading the value." 670 `:prompt-value' property of that widget will be used for reading the value.
671
672 If given a prefix (or a COMMENT argument), also prompt for a comment."
663 (interactive (custom-prompt-variable "Set variable: " 673 (interactive (custom-prompt-variable "Set variable: "
664 "Set %s to value: ")) 674 "Set %s to value: "
665 675 current-prefix-arg))
666 (set var val)) 676
677 (set var val)
678 (cond ((string= comment "")
679 (put var 'variable-comment nil))
680 (comment
681 (put var 'variable-comment comment))))
667 682
668 ;;;###autoload 683 ;;;###autoload
669 (defun customize-set-variable (var val) 684 (defun customize-set-variable (var val &optional comment)
670 "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. 685 "Set the default for VARIABLE to VALUE. VALUE is a Lisp object.
671 686
672 If VARIABLE has a `custom-set' property, that is used for setting 687 If VARIABLE has a `custom-set' property, that is used for setting
673 VARIABLE, otherwise `set-default' is used. 688 VARIABLE, otherwise `set-default' is used.
674 689
677 692
678 If VARIABLE has a `variable-interactive' property, that is used as if 693 If VARIABLE has a `variable-interactive' property, that is used as if
679 it were the arg to `interactive' (which see) to interactively read the value. 694 it were the arg to `interactive' (which see) to interactively read the value.
680 695
681 If VARIABLE has a `custom-type' property, it must be a widget and the 696 If VARIABLE has a `custom-type' property, it must be a widget and the
682 `:prompt-value' property of that widget will be used for reading the value. " 697 `:prompt-value' property of that widget will be used for reading the value.
698
699 If given a prefix (or a COMMENT argument), also prompt for a comment."
683 (interactive (custom-prompt-variable "Set variable: " 700 (interactive (custom-prompt-variable "Set variable: "
684 "Set customized value for %s to: ")) 701 "Set customized value for %s to: "
702 current-prefix-arg))
685 (funcall (or (get var 'custom-set) 'set-default) var val) 703 (funcall (or (get var 'custom-set) 'set-default) var val)
686 (put var 'customized-value (list (custom-quote val)))) 704 (put var 'customized-value (list (custom-quote val)))
705 (cond ((string= comment "")
706 (put var 'variable-comment nil)
707 (put var 'customized-variable-comment nil))
708 (comment
709 (put var 'variable-comment comment)
710 (put var 'customized-variable-comment comment))))
711
687 712
688 ;;;###autoload 713 ;;;###autoload
689 (defun customize-save-variable (var val) 714 (defun customize-save-variable (var val &optional comment)
690 "Set the default for VARIABLE to VALUE, and save it for future sessions. 715 "Set the default for VARIABLE to VALUE, and save it for future sessions.
691 If VARIABLE has a `custom-set' property, that is used for setting 716 If VARIABLE has a `custom-set' property, that is used for setting
692 VARIABLE, otherwise `set-default' is used. 717 VARIABLE, otherwise `set-default' is used.
693 718
694 The `customized-value' property of the VARIABLE will be set to a list 719 The `customized-value' property of the VARIABLE will be set to a list
696 721
697 If VARIABLE has a `variable-interactive' property, that is used as if 722 If VARIABLE has a `variable-interactive' property, that is used as if
698 it were the arg to `interactive' (which see) to interactively read the value. 723 it were the arg to `interactive' (which see) to interactively read the value.
699 724
700 If VARIABLE has a `custom-type' property, it must be a widget and the 725 If VARIABLE has a `custom-type' property, it must be a widget and the
701 `:prompt-value' property of that widget will be used for reading the value. " 726 `:prompt-value' property of that widget will be used for reading the value.
727
728 If given a prefix (or a COMMENT argument), also prompt for a comment."
702 (interactive (custom-prompt-variable "Set and ave variable: " 729 (interactive (custom-prompt-variable "Set and ave variable: "
703 "Set and save value for %s as: ")) 730 "Set and save value for %s as: "
731 current-prefix-arg))
704 (funcall (or (get var 'custom-set) 'set-default) var val) 732 (funcall (or (get var 'custom-set) 'set-default) var val)
705 (put var 'saved-value (list (custom-quote val))) 733 (put var 'saved-value (list (custom-quote val)))
734 (custom-push-theme 'theme-value var 'user 'set (list (custom-quote val)))
735 (cond ((string= comment "")
736 (put var 'variable-comment nil)
737 (put var 'saved-variable-comment nil))
738 (comment
739 (put var 'variable-comment comment)
740 (put var 'saved-variable-comment comment)))
706 (custom-save-all)) 741 (custom-save-all))
707 742
708 ;;;###autoload 743 ;;;###autoload
709 (defun customize (group) 744 (defun customize (group)
710 "Select a customization buffer which you can use to set user options. 745 "Select a customization buffer which you can use to set user options.
840 (defun customize-customized () 875 (defun customize-customized ()
841 "Customize all user options set since the last save in this session." 876 "Customize all user options set since the last save in this session."
842 (interactive) 877 (interactive)
843 (let ((found nil)) 878 (let ((found nil))
844 (mapatoms (lambda (symbol) 879 (mapatoms (lambda (symbol)
845 (and (get symbol 'customized-face) 880 (and (or (get symbol 'customized-face)
881 (get symbol 'customized-face-comment))
846 (find-face symbol) 882 (find-face symbol)
847 (push (list symbol 'custom-face) found)) 883 (push (list symbol 'custom-face) found))
848 (and (get symbol 'customized-value) 884 (and (or (get symbol 'customized-value)
885 (get symbol 'customized-variable-comment))
849 (boundp symbol) 886 (boundp symbol)
850 (push (list symbol 'custom-variable) found)))) 887 (push (list symbol 'custom-variable) found))))
851 (if (not found) 888 (if (not found)
852 (error "No customized user options") 889 (error "No customized user options")
853 (custom-buffer-create (custom-sort-items found t nil) 890 (custom-buffer-create (custom-sort-items found t nil)
857 (defun customize-saved () 894 (defun customize-saved ()
858 "Customize all already saved user options." 895 "Customize all already saved user options."
859 (interactive) 896 (interactive)
860 (let ((found nil)) 897 (let ((found nil))
861 (mapatoms (lambda (symbol) 898 (mapatoms (lambda (symbol)
862 (and (get symbol 'saved-face) 899 (and (or (get symbol 'saved-face)
900 (get symbol 'saved-face-comment))
863 (find-face symbol) 901 (find-face symbol)
864 (push (list symbol 'custom-face) found)) 902 (push (list symbol 'custom-face) found))
865 (and (get symbol 'saved-value) 903 (and (or (get symbol 'saved-value)
904 (get symbol 'saved-variable-comment))
866 (boundp symbol) 905 (boundp symbol)
867 (push (list symbol 'custom-variable) found)))) 906 (push (list symbol 'custom-variable) found))))
868 (if (not found ) 907 (if (not found )
869 (error "No saved user options") 908 (error "No saved user options")
870 (custom-buffer-create (custom-sort-items found t nil) 909 (custom-buffer-create (custom-sort-items found t nil)
1702 (widget-put widget :buttons buttons) 1741 (widget-put widget :buttons buttons)
1703 (if found 1742 (if found
1704 (insert "\n") 1743 (insert "\n")
1705 (delete-region start (point))) 1744 (delete-region start (point)))
1706 found)) 1745 found))
1746
1747 ;;; The `custom-comment' Widget.
1748
1749 ;; like the editable field
1750 (defface custom-comment-face '((((class grayscale color)
1751 (background light))
1752 (:background "gray85"))
1753 (((class grayscale color)
1754 (background dark))
1755 (:background "dim gray"))
1756 (t
1757 (:italic t)))
1758 "Face used for comments on variables or faces"
1759 :group 'custom-faces)
1760
1761 ;; like font-lock-comment-face
1762 (defface custom-comment-tag-face
1763 '((((class color) (background dark)) (:foreground "gray80"))
1764 (((class color) (background light)) (:foreground "blue4"))
1765 (((class grayscale) (background light))
1766 (:foreground "DimGray" :bold t :italic t))
1767 (((class grayscale) (background dark))
1768 (:foreground "LightGray" :bold t :italic t))
1769 (t (:bold t)))
1770 "Face used for variables or faces comment tags"
1771 :group 'custom-faces)
1772
1773 (define-widget 'custom-comment 'string
1774 "User comment"
1775 :tag "Comment"
1776 :help-echo "Edit a comment here"
1777 :sample-face 'custom-comment-tag-face
1778 :value-face 'custom-comment-face
1779 :value-set 'custom-comment-value-set
1780 :create 'custom-comment-create
1781 :delete 'custom-comment-delete)
1782
1783 (defun custom-comment-create (widget)
1784 (let (ext)
1785 (widget-default-create widget)
1786 (widget-put widget :comment-extent
1787 (setq ext (make-extent (widget-get widget :from)
1788 (widget-get widget :to))))
1789 (set-extent-property ext 'start-open t)
1790 (when (equal (widget-get widget :value) "")
1791 (set-extent-property ext 'invisible t))
1792 ))
1793
1794 (defun custom-comment-delete (widget)
1795 (widget-default-delete widget)
1796 (delete-extent (widget-get widget :comment-extent)))
1797
1798 (defun custom-comment-value-set (widget value)
1799 (widget-default-value-set widget value)
1800 (if (equal value "")
1801 (set-extent-property (widget-get widget :comment-extent)
1802 'invisible t)
1803 (set-extent-property (widget-get widget :comment-extent)
1804 'invisible nil)))
1805
1806 ;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
1807 ;; the global custom one
1808 (defun custom-comment-show (widget)
1809 (set-extent-property
1810 (widget-get (widget-get widget :comment-widget) :comment-extent)
1811 'invisible nil))
1812
1813 (defun custom-comment-invisible-p (widget)
1814 (extent-property
1815 (widget-get (widget-get widget :comment-widget) :comment-extent)
1816 'invisible))
1707 1817
1708 ;;; The `custom-variable' Widget. 1818 ;;; The `custom-variable' Widget.
1709 1819
1710 (defface custom-variable-tag-face '((((class color) 1820 (defface custom-variable-tag-face '((((class color)
1711 (background dark)) 1821 (background dark))
1868 widget type 1978 widget type
1869 :format value-format 1979 :format value-format
1870 :value value) 1980 :value value)
1871 children)))) 1981 children))))
1872 (unless (eq custom-buffer-style 'tree) 1982 (unless (eq custom-buffer-style 'tree)
1873 ;; Now update the state.
1874 (unless (eq (preceding-char) ?\n) 1983 (unless (eq (preceding-char) ?\n)
1875 (widget-insert "\n")) 1984 (widget-insert "\n"))
1876 (if (eq state 'hidden)
1877 (widget-put widget :custom-state state)
1878 (custom-variable-state-set widget))
1879 ;; Create the magic button. 1985 ;; Create the magic button.
1880 (let ((magic (widget-create-child-and-convert 1986 (let ((magic (widget-create-child-and-convert
1881 widget 'custom-magic nil))) 1987 widget 'custom-magic nil)))
1882 (widget-put widget :custom-magic magic) 1988 (widget-put widget :custom-magic magic)
1883 (push magic buttons)) 1989 (push magic buttons))
1884 ;; Update properties. 1990 ;; Insert documentation.
1991 ;; ### NOTE: this is ugly!!!! I need to do update the :buttons property
1992 ;; before the call to `widget-default-format-handler'. Otherwise, I
1993 ;; loose my current `buttons'. This function shouldn't be called like
1994 ;; this anyway. The doc string widget should be added like the others.
1995 ;; --dv
1996 (widget-put widget :buttons buttons)
1997 (widget-default-format-handler widget ?h)
1998 ;; The comment field
1999 (unless (eq state 'hidden)
2000 (let* ((comment (get symbol 'variable-comment))
2001 (comment-widget
2002 (widget-create-child-and-convert
2003 widget 'custom-comment
2004 :parent widget
2005 :value (or comment ""))))
2006 (widget-put widget :comment-widget comment-widget)
2007 ;; Don't push it !!! Custom assumes that the first child is the
2008 ;; value one.
2009 (setq children (append children (list comment-widget)))))
2010 ;; Update the rest of the properties properties.
1885 (widget-put widget :custom-form form) 2011 (widget-put widget :custom-form form)
1886 (widget-put widget :buttons buttons)
1887 (widget-put widget :children children) 2012 (widget-put widget :children children)
1888 ;; Insert documentation. 2013 ;; Now update the state.
1889 (widget-default-format-handler widget ?h) 2014 (if (eq state 'hidden)
2015 (widget-put widget :custom-state state)
2016 (custom-variable-state-set widget))
1890 ;; See also. 2017 ;; See also.
1891 (unless (eq state 'hidden) 2018 (unless (eq state 'hidden)
1892 (when (eq (widget-get widget :custom-level) 1) 2019 (when (eq (widget-get widget :custom-level) 1)
1893 (custom-add-parent-links widget)) 2020 (custom-add-parent-links widget))
1894 (custom-add-see-also widget))))) 2021 (custom-add-see-also widget)))))
1908 (let* ((symbol (widget-value widget)) 2035 (let* ((symbol (widget-value widget))
1909 (get (or (get symbol 'custom-get) 'default-value)) 2036 (get (or (get symbol 'custom-get) 'default-value))
1910 (value (if (default-boundp symbol) 2037 (value (if (default-boundp symbol)
1911 (funcall get symbol) 2038 (funcall get symbol)
1912 (widget-get widget :value))) 2039 (widget-get widget :value)))
2040 (comment (get symbol 'variable-comment))
1913 tmp 2041 tmp
1914 (state (cond ((setq tmp (get symbol 'customized-value)) 2042 temp
2043 (state (cond ((progn (setq tmp (get symbol 'customized-value))
2044 (setq temp
2045 (get symbol 'customized-variable-comment))
2046 (or tmp temp))
1915 (if (condition-case nil 2047 (if (condition-case nil
1916 (equal value (eval (car tmp))) 2048 (and (equal value (eval (car tmp)))
2049 (equal comment temp))
1917 (error nil)) 2050 (error nil))
1918 'set 2051 'set
1919 'changed)) 2052 'changed))
1920 ((setq tmp (get symbol 'saved-value)) 2053 ((progn (setq tmp (get symbol 'saved-value))
2054 (setq temp (get symbol 'saved-variable-comment))
2055 (or tmp temp))
1921 (if (condition-case nil 2056 (if (condition-case nil
1922 (equal value (eval (car tmp))) 2057 (and (equal value (eval (car tmp)))
2058 (equal comment temp))
1923 (error nil)) 2059 (error nil))
1924 'saved 2060 'saved
1925 'changed)) 2061 'changed))
1926 ((setq tmp (get symbol 'standard-value)) 2062 ((setq tmp (get symbol 'standard-value))
1927 (if (condition-case nil 2063 (if (condition-case nil
1928 (equal value (eval (car tmp))) 2064 (and (equal value (eval (car tmp)))
2065 (equal comment nil))
1929 (error nil)) 2066 (error nil))
1930 'standard 2067 'standard
1931 'changed)) 2068 'changed))
1932 (t 'rogue)))) 2069 (t 'rogue))))
1933 (widget-put widget :custom-state state))) 2070 (widget-put widget :custom-state state)))
1943 (lambda (widget) 2080 (lambda (widget)
1944 (and (default-boundp (widget-value widget)) 2081 (and (default-boundp (widget-value widget))
1945 (memq (widget-get widget :custom-state) '(modified changed))))) 2082 (memq (widget-get widget :custom-state) '(modified changed)))))
1946 ("Reset to Saved" custom-variable-reset-saved 2083 ("Reset to Saved" custom-variable-reset-saved
1947 (lambda (widget) 2084 (lambda (widget)
1948 (and (get (widget-value widget) 'saved-value) 2085 (and (or (get (widget-value widget) 'saved-value)
2086 (get (widget-value widget) 'saved-variable-comment))
1949 (memq (widget-get widget :custom-state) 2087 (memq (widget-get widget :custom-state)
1950 '(modified set changed rogue))))) 2088 '(modified set changed rogue)))))
1951 ("Reset to Standard Settings" custom-variable-reset-standard 2089 ("Reset to Standard Settings" custom-variable-reset-standard
1952 (lambda (widget) 2090 (lambda (widget)
1953 (and (get (widget-value widget) 'standard-value) 2091 (and (get (widget-value widget) 'standard-value)
1954 (memq (widget-get widget :custom-state) 2092 (memq (widget-get widget :custom-state)
1955 '(modified set changed saved rogue))))) 2093 '(modified set changed saved rogue)))))
2094 ("---" ignore ignore)
2095 ("Add Comment" custom-comment-show custom-comment-invisible-p)
1956 ("---" ignore ignore) 2096 ("---" ignore ignore)
1957 ("Don't show as Lisp expression" custom-variable-edit 2097 ("Don't show as Lisp expression" custom-variable-edit
1958 (lambda (widget) 2098 (lambda (widget)
1959 (eq (widget-get widget :custom-form) 'lisp))) 2099 (eq (widget-get widget :custom-form) 'lisp)))
1960 ("Show as Lisp expression" custom-variable-edit-lisp 2100 ("Show as Lisp expression" custom-variable-edit-lisp
2003 (let* ((form (widget-get widget :custom-form)) 2143 (let* ((form (widget-get widget :custom-form))
2004 (state (widget-get widget :custom-state)) 2144 (state (widget-get widget :custom-state))
2005 (child (car (widget-get widget :children))) 2145 (child (car (widget-get widget :children)))
2006 (symbol (widget-value widget)) 2146 (symbol (widget-value widget))
2007 (set (or (get symbol 'custom-set) 'set-default)) 2147 (set (or (get symbol 'custom-set) 'set-default))
2008 val) 2148 (comment-widget (widget-get widget :comment-widget))
2149 (comment (widget-value comment-widget))
2150 val)
2009 (cond ((eq state 'hidden) 2151 (cond ((eq state 'hidden)
2010 (error "Cannot set hidden variable")) 2152 (error "Cannot set hidden variable"))
2011 ((setq val (widget-apply child :validate)) 2153 ((setq val (widget-apply child :validate))
2012 (goto-char (widget-get val :from)) 2154 (goto-char (widget-get val :from))
2013 (error "%s" (widget-get val :error))) 2155 (error "%s" (widget-get val :error)))
2014 ((memq form '(lisp mismatch)) 2156 ((memq form '(lisp mismatch))
2157 (when (equal comment "")
2158 (setq comment nil)
2159 ;; Make the comment invisible by hand if it's empty
2160 (set-extent-property (widget-get comment-widget :comment-extent)
2161 'invisible t))
2015 (funcall set symbol (eval (setq val (widget-value child)))) 2162 (funcall set symbol (eval (setq val (widget-value child))))
2016 (put symbol 'customized-value (list val))) 2163 (put symbol 'customized-value (list val))
2164 (put symbol 'variable-comment comment)
2165 (put symbol 'customized-variable-comment comment))
2017 (t 2166 (t
2167 (when (equal comment "")
2168 (setq comment nil)
2169 ;; Make the comment invisible by hand if it's empty
2170 (set-extent-property (widget-get comment-widget :comment-extent)
2171 'invisible t))
2018 (funcall set symbol (setq val (widget-value child))) 2172 (funcall set symbol (setq val (widget-value child)))
2019 (put symbol 'customized-value (list (custom-quote val))))) 2173 (put symbol 'customized-value (list (custom-quote val)))
2174 (put symbol 'variable-comment comment)
2175 (put symbol 'customized-variable-comment comment)))
2020 (custom-variable-state-set widget) 2176 (custom-variable-state-set widget)
2021 (custom-redraw-magic widget))) 2177 (custom-redraw-magic widget)))
2022 2178
2023 (defun custom-variable-save (widget) 2179 (defun custom-variable-save (widget)
2024 "Set and save the value for the variable being edited by WIDGET." 2180 "Set and save the value for the variable being edited by WIDGET."
2025 (let* ((form (widget-get widget :custom-form)) 2181 (let* ((form (widget-get widget :custom-form))
2026 (state (widget-get widget :custom-state)) 2182 (state (widget-get widget :custom-state))
2027 (child (car (widget-get widget :children))) 2183 (child (car (widget-get widget :children)))
2028 (symbol (widget-value widget)) 2184 (symbol (widget-value widget))
2029 (set (or (get symbol 'custom-set) 'set-default)) 2185 (set (or (get symbol 'custom-set) 'set-default))
2186 (comment-widget (widget-get widget :comment-widget))
2187 (comment (widget-value comment-widget))
2030 val) 2188 val)
2031 (cond ((eq state 'hidden) 2189 (cond ((eq state 'hidden)
2032 (error "Cannot set hidden variable")) 2190 (error "Cannot set hidden variable"))
2033 ((setq val (widget-apply child :validate)) 2191 ((setq val (widget-apply child :validate))
2034 (goto-char (widget-get val :from)) 2192 (goto-char (widget-get val :from))
2035 (error "%s" (widget-get val :error))) 2193 (error "%s" (widget-get val :error)))
2036 ((memq form '(lisp mismatch)) 2194 ((memq form '(lisp mismatch))
2195 (when (equal comment "")
2196 (setq comment nil)
2197 ;; Make the comment invisible by hand if it's empty
2198 (set-extent-property (widget-get comment-widget :comment-extent)
2199 'invisible t))
2037 (put symbol 'saved-value (list (widget-value child))) 2200 (put symbol 'saved-value (list (widget-value child)))
2038 (funcall set symbol (eval (widget-value child)))) 2201 (custom-push-theme 'theme-value symbol 'user
2202 'set (list (widget-value child)))
2203 (funcall set symbol (eval (widget-value child)))
2204 (put symbol 'variable-comment comment)
2205 (put symbol 'saved-variable-comment comment))
2039 (t 2206 (t
2207 (when (equal comment "")
2208 (setq comment nil)
2209 ;; Make the comment invisible by hand if it's empty
2210 (set-extent-property (widget-get comment-widget :comment-extent)
2211 'invisible t))
2040 (put symbol 2212 (put symbol
2041 'saved-value (list (custom-quote (widget-value 2213 'saved-value (list (custom-quote (widget-value
2042 child)))) 2214 child))))
2043 (funcall set symbol (widget-value child)))) 2215 (custom-push-theme 'theme-value symbol 'user
2216 'set (list (custom-quote (widget-value
2217 child))))
2218 (funcall set symbol (widget-value child))
2219 (put symbol 'variable-comment comment)
2220 (put symbol 'saved-variable-comment comment)))
2044 (put symbol 'customized-value nil) 2221 (put symbol 'customized-value nil)
2222 (put symbol 'customized-variable-comment nil)
2045 (custom-save-all) 2223 (custom-save-all)
2046 (custom-variable-state-set widget) 2224 (custom-variable-state-set widget)
2047 (custom-redraw-magic widget))) 2225 (custom-redraw-magic widget)))
2048 2226
2049 (defun custom-variable-reset-saved (widget) 2227 (defun custom-variable-reset-saved (widget)
2050 "Restore the saved value for the variable being edited by WIDGET." 2228 "Restore the saved value for the variable being edited by WIDGET."
2051 (let* ((symbol (widget-value widget)) 2229 (let* ((symbol (widget-value widget))
2052 (set (or (get symbol 'custom-set) 'set-default))) 2230 (set (or (get symbol 'custom-set) 'set-default))
2053 (if (get symbol 'saved-value) 2231 (comment-widget (widget-get widget :comment-widget))
2054 (condition-case nil 2232 (value (get symbol 'saved-value))
2055 (funcall set symbol (eval (car (get symbol 'saved-value)))) 2233 (comment (get symbol 'saved-variable-comment)))
2056 (error nil)) 2234 (cond ((or value comment)
2057 (signal 'error (list "No saved value for variable" symbol))) 2235 (put symbol 'variable-comment comment)
2236 (condition-case nil
2237 (funcall set symbol (eval (car value)))
2238 (error nil)))
2239 (t
2240 (signal 'error (list "No saved value for variable" symbol))))
2058 (put symbol 'customized-value nil) 2241 (put symbol 'customized-value nil)
2242 (put symbol 'customized-variable-comment nil)
2059 (widget-put widget :custom-state 'unknown) 2243 (widget-put widget :custom-state 'unknown)
2244 ;; This call will possibly make the comment invisible
2060 (custom-redraw widget))) 2245 (custom-redraw widget)))
2061 2246
2062 (defun custom-variable-reset-standard (widget) 2247 (defun custom-variable-reset-standard (widget)
2063 "Restore the standard setting for the variable being edited by WIDGET." 2248 "Restore the standard setting for the variable being edited by WIDGET."
2064 (let* ((symbol (widget-value widget)) 2249 (let* ((symbol (widget-value widget))
2065 (set (or (get symbol 'custom-set) 'set-default))) 2250 (set (or (get symbol 'custom-set) 'set-default))
2251 (comment-widget (widget-get widget :comment-widget)))
2066 (if (get symbol 'standard-value) 2252 (if (get symbol 'standard-value)
2067 (funcall set symbol (eval (car (get symbol 'standard-value)))) 2253 (funcall set symbol (eval (car (get symbol 'standard-value))))
2068 (signal 'error (list "No standard setting known for variable" symbol))) 2254 (signal 'error (list "No standard setting known for variable" symbol)))
2255 (put symbol 'variable-comment nil)
2069 (put symbol 'customized-value nil) 2256 (put symbol 'customized-value nil)
2070 (when (get symbol 'saved-value) 2257 (put symbol 'customized-variable-comment nil)
2258 (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
2071 (put symbol 'saved-value nil) 2259 (put symbol 'saved-value nil)
2260 (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
2261 ;; As a special optimizations we do not (explictly)
2262 ;; save resets to standard when no theme set the value.
2263 (if (null (cdr (get symbol 'theme-value)))
2264 (put symbol 'theme-value nil))
2265 (put symbol 'saved-variable-comment nil)
2072 (custom-save-all)) 2266 (custom-save-all))
2073 (widget-put widget :custom-state 'unknown) 2267 (widget-put widget :custom-state 'unknown)
2268 ;; This call will possibly make the comment invisible
2074 (custom-redraw widget))) 2269 (custom-redraw widget)))
2075 2270
2076 ;;; The `custom-face-edit' Widget. 2271 ;;; The `custom-face-edit' Widget.
2077 2272
2078 (define-widget 'custom-face-edit 'checklist 2273 (define-widget 'custom-face-edit 'checklist
2223 "Converted version of the `custom-face-selected' widget.") 2418 "Converted version of the `custom-face-selected' widget.")
2224 2419
2225 (defun custom-face-value-create (widget) 2420 (defun custom-face-value-create (widget)
2226 "Create a list of the display specifications for WIDGET." 2421 "Create a list of the display specifications for WIDGET."
2227 (let ((buttons (widget-get widget :buttons)) 2422 (let ((buttons (widget-get widget :buttons))
2423 children
2228 (symbol (widget-get widget :value)) 2424 (symbol (widget-get widget :value))
2229 (tag (widget-get widget :tag)) 2425 (tag (widget-get widget :tag))
2230 (state (widget-get widget :custom-state)) 2426 (state (widget-get widget :custom-state))
2231 (begin (point)) 2427 (begin (point))
2232 (is-last (widget-get widget :custom-last)) 2428 (is-last (widget-get widget :custom-last))
2272 (push magic buttons)) 2468 (push magic buttons))
2273 ;; Update buttons. 2469 ;; Update buttons.
2274 (widget-put widget :buttons buttons) 2470 (widget-put widget :buttons buttons)
2275 ;; Insert documentation. 2471 ;; Insert documentation.
2276 (widget-default-format-handler widget ?h) 2472 (widget-default-format-handler widget ?h)
2473 ;; The comment field
2474 (unless (eq state 'hidden)
2475 (let* ((comment (get symbol 'face-comment))
2476 (comment-widget
2477 (widget-create-child-and-convert
2478 widget 'custom-comment
2479 :parent widget
2480 :value (or comment ""))))
2481 (widget-put widget :comment-widget comment-widget)
2482 (push comment-widget children)))
2277 ;; See also. 2483 ;; See also.
2278 (unless (eq state 'hidden) 2484 (unless (eq state 'hidden)
2279 (when (eq (widget-get widget :custom-level) 1) 2485 (when (eq (widget-get widget :custom-level) 1)
2280 (custom-add-parent-links widget)) 2486 (custom-add-parent-links widget))
2281 (custom-add-see-also widget)) 2487 (custom-add-see-also widget))
2305 (t 2511 (t
2306 (when indent (insert-char ?\ indent)) 2512 (when indent (insert-char ?\ indent))
2307 'sexp)) 2513 'sexp))
2308 :value spec))) 2514 :value spec)))
2309 (custom-face-state-set widget) 2515 (custom-face-state-set widget)
2310 (widget-put widget :children (list edit))) 2516 (push edit children)
2517 (widget-put widget :children children))
2311 (message "Creating face editor...done")))))) 2518 (message "Creating face editor...done"))))))
2312 2519
2313 (defvar custom-face-menu 2520 (defvar custom-face-menu
2314 '(("Set for Current Session" custom-face-set) 2521 '(("Set for Current Session" custom-face-set)
2315 ("Save for Future Sessions" custom-face-save) 2522 ("Save for Future Sessions" custom-face-save)
2316 ("Reset to Saved" custom-face-reset-saved 2523 ("Reset to Saved" custom-face-reset-saved
2317 (lambda (widget) 2524 (lambda (widget)
2318 (get (widget-value widget) 'saved-face))) 2525 (or (get (widget-value widget) 'saved-face)
2526 (get (widget-value widget) 'saved-face-comment))))
2319 ("Reset to Standard Setting" custom-face-reset-standard 2527 ("Reset to Standard Setting" custom-face-reset-standard
2320 (lambda (widget) 2528 (lambda (widget)
2321 (get (widget-value widget) 'face-defface-spec))) 2529 (get (widget-value widget) 'face-defface-spec)))
2530 ("---" ignore ignore)
2531 ("Add Comment" custom-comment-show custom-comment-invisible-p)
2322 ("---" ignore ignore) 2532 ("---" ignore ignore)
2323 ("Show all display specs" custom-face-edit-all 2533 ("Show all display specs" custom-face-edit-all
2324 (lambda (widget) 2534 (lambda (widget)
2325 (not (eq (widget-get widget :custom-form) 'all)))) 2535 (not (eq (widget-get widget :custom-form) 'all))))
2326 ("Just current attributes" custom-face-edit-selected 2536 ("Just current attributes" custom-face-edit-selected
2354 (widget-put widget :custom-form 'lisp) 2564 (widget-put widget :custom-form 'lisp)
2355 (custom-redraw widget)) 2565 (custom-redraw widget))
2356 2566
2357 (defun custom-face-state-set (widget) 2567 (defun custom-face-state-set (widget)
2358 "Set the state of WIDGET." 2568 "Set the state of WIDGET."
2359 (let ((symbol (widget-value widget))) 2569 (let* ((symbol (widget-value widget))
2360 (widget-put widget :custom-state (cond ((get symbol 'customized-face) 2570 (comment (get symbol 'face-comment))
2361 'set) 2571 tmp temp)
2362 ((get symbol 'saved-face) 2572 (widget-put widget :custom-state
2363 'saved) 2573 (cond ((progn
2364 ((get symbol 'face-defface-spec) 2574 (setq tmp (get symbol 'customized-face))
2365 'standard) 2575 (setq temp (get symbol 'customized-face-comment))
2366 (t 2576 (or tmp temp))
2367 'rogue))))) 2577 (if (equal temp comment)
2578 'set
2579 'changed))
2580 ((progn
2581 (setq tmp (get symbol 'saved-face))
2582 (setq temp (get symbol 'saved-face-comment))
2583 (or tmp temp))
2584 (if (equal temp comment)
2585 'saved
2586 'changed))
2587 ((get symbol 'face-defface-spec)
2588 (if (equal comment nil)
2589 'standard
2590 'changed))
2591 (t
2592 'rogue)))))
2368 2593
2369 (defun custom-face-action (widget &optional event) 2594 (defun custom-face-action (widget &optional event)
2370 "Show the menu for `custom-face' WIDGET. 2595 "Show the menu for `custom-face' WIDGET.
2371 Optional EVENT is the location for the menu." 2596 Optional EVENT is the location for the menu."
2372 (if (eq (widget-get widget :custom-state) 'hidden) 2597 (if (eq (widget-get widget :custom-state) 'hidden)
2383 2608
2384 (defun custom-face-set (widget) 2609 (defun custom-face-set (widget)
2385 "Make the face attributes in WIDGET take effect." 2610 "Make the face attributes in WIDGET take effect."
2386 (let* ((symbol (widget-value widget)) 2611 (let* ((symbol (widget-value widget))
2387 (child (car (widget-get widget :children))) 2612 (child (car (widget-get widget :children)))
2388 (value (widget-value child))) 2613 (value (widget-value child))
2614 (comment-widget (widget-get widget :comment-widget))
2615 (comment (widget-value comment-widget)))
2616 (when (equal comment "")
2617 (setq comment nil)
2618 ;; Make the comment invisible by hand if it's empty
2619 (set-extent-property (widget-get comment-widget :comment-extent)
2620 'invisible t))
2389 (put symbol 'customized-face value) 2621 (put symbol 'customized-face value)
2390 (face-spec-set symbol value nil '(custom)) 2622 (face-spec-set symbol value nil '(custom))
2623 (put symbol 'customized-face-comment comment)
2624 (put symbol 'face-comment comment)
2391 (custom-face-state-set widget) 2625 (custom-face-state-set widget)
2392 (custom-redraw-magic widget))) 2626 (custom-redraw-magic widget)))
2393 2627
2394 (defun custom-face-save (widget) 2628 (defun custom-face-save (widget)
2395 "Make the face attributes in WIDGET default." 2629 "Make the face attributes in WIDGET default."
2396 (let* ((symbol (widget-value widget)) 2630 (let* ((symbol (widget-value widget))
2397 (child (car (widget-get widget :children))) 2631 (child (car (widget-get widget :children)))
2398 (value (widget-value child))) 2632 (value (widget-value child))
2633 (comment-widget (widget-get widget :comment-widget))
2634 (comment (widget-value comment-widget)))
2635 (when (equal comment "")
2636 (setq comment nil)
2637 ;; Make the comment invisible by hand if it's empty
2638 (set-extent-property (widget-get comment-widget :comment-extent)
2639 'invisible t))
2399 (face-spec-set symbol value nil '(custom)) 2640 (face-spec-set symbol value nil '(custom))
2400 (put symbol 'saved-face value) 2641 (put symbol 'saved-face value)
2642 (custom-push-theme 'theme-face symbol 'user 'set value)
2401 (put symbol 'customized-face nil) 2643 (put symbol 'customized-face nil)
2644 (put symbol 'face-comment comment)
2645 (put symbol 'customized-face-comment nil)
2646 (put symbol 'saved-face-comment comment)
2402 (custom-save-all) 2647 (custom-save-all)
2403 (custom-face-state-set widget) 2648 (custom-face-state-set widget)
2404 (custom-redraw-magic widget))) 2649 (custom-redraw-magic widget)))
2405 2650
2406 (defun custom-face-reset-saved (widget) 2651 (defun custom-face-reset-saved (widget)
2407 "Restore WIDGET to the face's default attributes." 2652 "Restore WIDGET to the face's default attributes."
2408 (let* ((symbol (widget-value widget)) 2653 (let* ((symbol (widget-value widget))
2409 (child (car (widget-get widget :children))) 2654 (child (car (widget-get widget :children)))
2410 (value (get symbol 'saved-face))) 2655 (value (get symbol 'saved-face))
2411 (unless value 2656 (comment (get symbol 'saved-face-comment))
2657 (comment-widget (widget-get widget :comment-widget)))
2658 (unless (or value comment)
2412 (signal 'error (list "No saved value for this face" symbol))) 2659 (signal 'error (list "No saved value for this face" symbol)))
2413 (put symbol 'customized-face nil) 2660 (put symbol 'customized-face nil)
2661 (put symbol 'customized-face-comment nil)
2414 (face-spec-set symbol value nil '(custom)) 2662 (face-spec-set symbol value nil '(custom))
2663 (put symbol 'face-comment comment)
2415 (widget-value-set child value) 2664 (widget-value-set child value)
2665 ;; This call manages the comment visibility
2666 (widget-value-set comment-widget (or comment ""))
2416 (custom-face-state-set widget) 2667 (custom-face-state-set widget)
2417 (custom-redraw-magic widget))) 2668 (custom-redraw-magic widget)))
2418 2669
2419 (defun custom-face-reset-standard (widget) 2670 (defun custom-face-reset-standard (widget)
2420 "Restore WIDGET to the face's standard settings." 2671 "Restore WIDGET to the face's standard settings."
2421 (let* ((symbol (widget-value widget)) 2672 (let* ((symbol (widget-value widget))
2422 (child (car (widget-get widget :children))) 2673 (child (car (widget-get widget :children)))
2423 (value (get symbol 'face-defface-spec))) 2674 (value (get symbol 'face-defface-spec))
2675 (comment-widget (widget-get widget :comment-widget)))
2424 (unless value 2676 (unless value
2425 (signal 'error (list "No standard setting for this face" symbol))) 2677 (signal 'error (list "No standard setting for this face" symbol)))
2426 (put symbol 'customized-face nil) 2678 (put symbol 'customized-face nil)
2427 (when (get symbol 'saved-face) 2679 (put symbol 'customized-face-comment nil)
2680 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
2428 (put symbol 'saved-face nil) 2681 (put symbol 'saved-face nil)
2682 (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
2683 ;; Do not explictly save resets to standards without themes.
2684 (if (null (cdr (get symbol 'theme-face)))
2685 (put symbol 'theme-face nil))
2686 (put symbol 'saved-face-comment nil)
2429 (custom-save-all)) 2687 (custom-save-all))
2430 (face-spec-set symbol value nil '(custom)) 2688 (face-spec-set symbol value nil '(custom))
2689 (put symbol 'face-comment nil)
2431 (widget-value-set child value) 2690 (widget-value-set child value)
2691 ;; This call manages the comment visibility
2692 (widget-value-set comment-widget "")
2432 (custom-face-state-set widget) 2693 (custom-face-state-set widget)
2433 (custom-redraw-magic widget))) 2694 (custom-redraw-magic widget)))
2434 2695
2435 ;;; The `face' Widget. 2696 ;;; The `face' Widget.
2436 2697
2975 explicitly load that file for the settings to take effect." 3236 explicitly load that file for the settings to take effect."
2976 :type 'file 3237 :type 'file
2977 :group 'customize) 3238 :group 'customize)
2978 3239
2979 (defun custom-save-delete (symbol) 3240 (defun custom-save-delete (symbol)
2980 "Delete the call to SYMBOL form `custom-file'. 3241 "Delete the call to SYMBOL form in `custom-file'.
2981 Leave point at the location of the call, or after the last expression." 3242 Leave point at the location of the call, or after the last expression."
2982 (let ((find-file-hooks nil) 3243 (let ((find-file-hooks nil)
2983 (auto-mode-alist nil)) 3244 (auto-mode-alist nil))
2984 (set-buffer (find-file-noselect custom-file))) 3245 (set-buffer (find-file-noselect custom-file)))
2985 (goto-char (point-min)) 3246 (goto-char (point-min))
2995 (point)) 3256 (point))
2996 (point)) 3257 (point))
2997 (throw 'found nil)))))) 3258 (throw 'found nil))))))
2998 3259
2999 (defun custom-save-variables () 3260 (defun custom-save-variables ()
3000 "Save all customized variables in `custom-file'." 3261 "Save all customized variables in `custom-file'."
3001 (save-excursion 3262 (save-excursion
3002 (custom-save-delete 'custom-set-variables) 3263 (custom-save-delete 'custom-load-themes)
3003 (let ((standard-output (current-buffer))) 3264 (custom-save-delete 'custom-reset-variables)
3004 (unless (bolp) 3265 (custom-save-delete 'custom-set-variables)
3005 (princ "\n")) 3266 (custom-save-loaded-themes)
3006 (princ "(custom-set-variables") 3267 (custom-save-resets 'theme-value 'custom-reset-variables nil)
3007 (mapatoms (lambda (symbol) 3268 (let ((standard-output (current-buffer)))
3008 (let ((value (get symbol 'saved-value)) 3269 (unless (bolp)
3009 (requests (get symbol 'custom-requests)) 3270 (princ "\n"))
3010 (now (not (or (get symbol 'standard-value) 3271 (princ "(custom-set-variables")
3011 (and (not (boundp symbol)) 3272 (mapatoms (lambda (symbol)
3012 (not (get symbol 'force-value))))))) 3273 (let ((spec (car-safe (get symbol 'theme-value)))
3013 (when value 3274 (requests (get symbol 'custom-requests))
3014 (princ "\n '(") 3275 (now (not (or (get symbol 'standard-value)
3015 (prin1 symbol) 3276 (and (not (boundp symbol))
3016 (princ " ") 3277 (not (eq (get symbol 'force-value)
3017 (prin1 (car value)) 3278 'rogue))))))
3018 (cond (requests 3279 (comment (get symbol 'saved-variable-comment)))
3019 (if now 3280 (when (or (and spec (eq (car spec) 'user)
3020 (princ " t ") 3281 (eq (second spec) 'set)) comment)
3021 (princ " nil ")) 3282 (princ "\n '(")
3022 (prin1 requests) 3283 (princ symbol)
3023 (princ ")")) 3284 (princ " ")
3024 (now 3285 ;; This comment stuf is in the way ####
3025 (princ " t)")) 3286 ;; Is (eq (third spec) (car saved-value)) ????
3026 (t 3287 ;; (prin1 (third spec))
3027 (princ ")"))))))) 3288 (prin1 (car (get symbol 'saved-value)))
3289 (when (or now requests comment)
3290 (princ (if now " t" " nil")))
3291 (when (or comment requests)
3292 (princ " ")
3293 (prin1 requests))
3294 (when comment
3295 (princ " ")
3296 (prin1 comment))
3297 (princ ")")))))
3028 (princ ")") 3298 (princ ")")
3029 (unless (looking-at "\n") 3299 (unless (looking-at "\n")
3030 (princ "\n"))))) 3300 (princ "\n")))))
3031 3301
3302 (defvar custom-save-face-ignoring nil)
3303
3304 (defun custom-save-face-internal (symbol)
3305 (let ((theme-spec (car-safe (get symbol 'theme-face)))
3306 (comment (get symbol 'saved-face-comment))
3307 (now (not (or (get symbol 'face-defface-spec)
3308 (and (not (find-face symbol))
3309 (not (eq (get symbol 'force-face) 'rogue)))))))
3310 (when (or (and (not (memq symbol custom-save-face-ignoring))
3311 ;; Don't print default face here.
3312 theme-spec
3313 (eq (car theme-spec) 'user)
3314 (eq (second theme-spec) 'set)) comment)
3315 (princ "\n '(")
3316 (princ symbol)
3317 (princ " ")
3318 (prin1 (get symbol 'saved-face))
3319 (if (or comment now)
3320 (princ (if now " t" " nil")))
3321 (when comment
3322 (princ " ")
3323 (prin1 comment))
3324 (princ ")"))))
3325
3032 (defun custom-save-faces () 3326 (defun custom-save-faces ()
3033 "Save all customized faces in `custom-file'." 3327 "Save all customized faces in `custom-file'."
3034 (save-excursion 3328 (save-excursion
3329 (custom-save-delete 'custom-reset-faces)
3035 (custom-save-delete 'custom-set-faces) 3330 (custom-save-delete 'custom-set-faces)
3331 (custom-save-resets 'theme-face 'custom-reset-faces '(default))
3036 (let ((standard-output (current-buffer))) 3332 (let ((standard-output (current-buffer)))
3037 (unless (bolp) 3333 (unless (bolp)
3038 (princ "\n")) 3334 (princ "\n"))
3039 (princ "(custom-set-faces") 3335 (princ "(custom-set-faces")
3040 (let ((value (get 'default 'saved-face)))
3041 ;; The default face must be first, since it affects the others. 3336 ;; The default face must be first, since it affects the others.
3042 (when value 3337 (custom-save-face-internal 'default)
3043 (princ "\n '(default ") 3338 (let ((custom-save-face-ignoring '(default)))
3044 (prin1 value) 3339 (mapatoms #'custom-save-face-internal))
3045 (if (or (get 'default 'face-defface-spec)
3046 (and (not (find-face 'default))
3047 (not (get 'default 'force-face))))
3048 (princ ")")
3049 (princ " t)"))))
3050 (mapatoms (lambda (symbol)
3051 (let ((value (get symbol 'saved-face)))
3052 (when (and (not (eq symbol 'default))
3053 ;; Don't print default face here.
3054 value)
3055 (princ "\n '(")
3056 (prin1 symbol)
3057 (princ " ")
3058 (prin1 value)
3059 (if (or (get symbol 'face-defface-spec)
3060 (and (not (find-face symbol))
3061 (not (get symbol 'force-face))))
3062 (princ ")")
3063 (princ " t)"))))))
3064 (princ ")") 3340 (princ ")")
3065 (unless (looking-at "\n") 3341 (unless (looking-at "\n")
3066 (princ "\n"))))) 3342 (princ "\n")))))
3343
3344 (defun custom-save-resets (property setter special)
3345 (let (started-writing ignored-special)
3346 ;; (custom-save-delete setter) Done by caller
3347 (let ((standard-output (current-buffer))
3348 (mapper `(lambda (object)
3349 (let ((spec (car-safe (get object (quote ,property)))))
3350 (when (and (not (memq object ignored-special))
3351 (eq (car spec) 'user)
3352 (eq (second spec) 'reset))
3353 ;; Do not write reset statements unless necessary.
3354 (unless started-writing
3355 (setq started-writing t)
3356 (unless (bolp)
3357 (princ "\n"))
3358 (princ "(")
3359 (princ (quote ,setter))
3360 (princ "\n '(")
3361 (princ object)
3362 (princ " ")
3363 (prin1 (third spec))
3364 (princ ")")))))))
3365 (mapc mapper special)
3366 (setq ignored-special special)
3367 (mapatoms mapper)
3368 (when started-writing
3369 (princ ")\n")))))
3370
3371
3372 (defun custom-save-loaded-themes ()
3373 (let ((themes (reverse (get 'user 'theme-loads-themes)))
3374 (standard-output (current-buffer)))
3375 (when themes
3376 (unless (bolp) (princ "\n"))
3377 (princ "(custom-load-themes")
3378 (mapc (lambda (theme)
3379 (princ "\n '")
3380 (prin1 theme)) themes)
3381 (princ " )\n"))))
3067 3382
3068 ;;;###autoload 3383 ;;;###autoload
3069 (defun customize-save-customized () 3384 (defun customize-save-customized ()
3070 "Save all user options which have been set in this session." 3385 "Save all user options which have been set in this session."
3071 (interactive) 3386 (interactive)
3072 (mapatoms (lambda (symbol) 3387 (mapatoms (lambda (symbol)
3073 (let ((face (get symbol 'customized-face)) 3388 (let ((face (get symbol 'customized-face))
3074 (value (get symbol 'customized-value))) 3389 (value (get symbol 'customized-value))
3390 (face-comment (get symbol 'customized-face-comment))
3391 (variable-comment
3392 (get symbol 'customized-variable-comment)))
3075 (when face 3393 (when face
3076 (put symbol 'saved-face face) 3394 (put symbol 'saved-face face)
3395 (custom-push-theme 'theme-face symbol 'user 'set value)
3077 (put symbol 'customized-face nil)) 3396 (put symbol 'customized-face nil))
3078 (when value 3397 (when value
3079 (put symbol 'saved-value value) 3398 (put symbol 'saved-value value)
3080 (put symbol 'customized-value nil))))) 3399 (custom-push-theme 'theme-value symbol 'user 'set value)
3400 (put symbol 'customized-value nil))
3401 (when variable-comment
3402 (put symbol 'saved-variable-comment variable-comment)
3403 (put symbol 'customized-variable-comment nil))
3404 (when face-comment
3405 (put symbol 'saved-face-comment face-comment)
3406 (put symbol 'customized-face-comment nil)))))
3081 ;; We really should update all custom buffers here. 3407 ;; We really should update all custom buffers here.
3082 (custom-save-all)) 3408 (custom-save-all))
3083 3409
3084 ;;;###autoload 3410 ;;;###autoload
3085 (defun custom-save-all () 3411 (defun custom-save-all ()