annotate lisp/cus-edit.el @ 4843:715b15990d0a

add more foo_checking_assert macros lisp.h: Add structure_checking_assert(), gc_checking_assert(), etc. for all types of error-checking. Also FOO_checking_assert_with_message() and inline_FOO_checking_assert() -- the latter for use in an inline function where you want the calling function's line/file to be reported (requires some conspiracy with the function itself). Add disabled_assert(), disabled_assert_at_line(), disabled_assert_with_message(), for what to do when an assert is disabled. Formerly, we used to do ((void) 0), but now we do ((void) x), so the variable appears used and any side effects of the expression do get done. In Unicode-internal, the standard assert() uses this, but not yet in this workspace.
author Ben Wing <ben@xemacs.org>
date Wed, 13 Jan 2010 03:01:43 -0600
parents fd36a980d701
children f00192e1cd49 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 ;;
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3 ;; Copyright (C) 2007, 2008 Didier Verna
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
4 ;; Copyright (C) 2003 Ben Wing
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
5 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
8 ;; Maintainer: Didier Verna <didier@xemacs.org>
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; Keywords: help, faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; Version: 1.9960-x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; XEmacs is free software; you can redistribute it and/or modify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; it under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; XEmacs is distributed in the hope that it will be useful,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; GNU General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; This file implements the code to create and edit customize buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; See `custom.el'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; No commands should have names starting with `custom-' because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; that interferes with completion. Use `customize-' for commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; that the user will run with M-x, and `Custom-' for interactive commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; NOTE: In many places within this file we use `mapatoms', which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; very slow in an average XEmacs because of the large number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; symbols requiring a large number of funcalls -- XEmacs with Gnus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; can grow to some 17000 symbols without ever doing anything fancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; It would probably pay off to make a hash table of symbols known to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; Custom, similar to custom-group-hash-table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; This is not top priority, because none of the functions that do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; mapatoms are speed-critical (the one that was now uses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; custom-group-hash-table), but it would be nice to have.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (require 'cus-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (require 'wid-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (require 'easymenu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (require 'cus-load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (require 'cus-start)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
60 (require 'cus-file)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; Huh? This looks dirty!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (put 'custom-define-hook 'custom-type 'hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (put 'custom-define-hook 'standard-value '(nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;;; Customization Groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (defgroup emacs nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 "Customization of the One True Editor."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 :link '(custom-manual "(XEmacs)Top"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; Most of these groups are stolen from `finder.el',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (defgroup editing nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 "Basic text editing facilities."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (defgroup matching nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 "Various sorts of searching and matching."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (defgroup emulations nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 "Emulations of other editors."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (defgroup outlines nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 "Support for hierarchical outlining."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (defgroup external nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 "Interfacing to external utilities."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (defgroup bib nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 "Code related to the `bib' bibliography processor."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 :tag "Bibliography"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 :group 'external)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (defgroup programming nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 "Support for programming in other languages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (defgroup languages nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 "Specialized modes for editing programming languages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 :group 'programming)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 ;; #### This should be in cc-vars.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (defgroup c nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 "Support for the C language and related languages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 :group 'languages)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (defgroup tools nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 "Programming tools."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 :group 'programming)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (defgroup oop nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 "Support for object-oriented programming."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 :group 'programming)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (defgroup applications nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 "Applications written in Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 ;; #### This should be in calendar.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (defgroup calendar nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 "Calendar and time management support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (defgroup mail nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 "Modes for electronic-mail handling."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (defgroup news nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 "Support for netnews reading and posting."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (defgroup games nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 "Games, jokes and amusements."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (defgroup development nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 "Support for further development of Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (defgroup docs nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 "Support for Emacs documentation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (defgroup extensions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 "Emacs Lisp language extensions."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (defgroup internal nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 "Code for Emacs internals, build process, defaults."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (defgroup maint nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 "Maintenance aids for the Emacs development group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 :tag "Maintenance"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (defgroup environment nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 "Fitting Emacs with its environment."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (defgroup comm nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 "Communications, networking, remote access to files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 :tag "Communication"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (defgroup hardware nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 "Support for interfacing with exotic hardware."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (defgroup terminals nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 "Support for terminal types."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (defgroup unix nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 "Front-ends/assistants for, or emulators of, UNIX features."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (defgroup i18n nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 "Internationalization and alternate character-set support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 :group 'environment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (defgroup data nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 "Support editing files of data."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (defgroup wp nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 "Word processing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (defgroup tex nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 "Code related to the TeX formatter."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 :group 'wp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (defgroup hypermedia nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 "Support for links between text or other media types."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (defgroup local nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 "Code local to your site."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (defgroup customize '((widgets custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 "Customization of the Customization support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 :link '(custom-manual "(custom)Top")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 :link '(url-link :tag "Development Page"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 "http://www.dina.kvl.dk/~abraham/custom/")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 :group 'help)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (defgroup custom-faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 "Faces used by customize."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 :group 'customize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 :group 'faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (defgroup custom-browse nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 "Control customize browser."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (defgroup custom-buffer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 "Control customize buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (defgroup custom-menu nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 "Control customize menus."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (defgroup alloc nil
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 555
diff changeset
237 "Storage allocation and gc for XEmacs Lisp interpreter."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 :tag "Storage Allocation"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 :group 'internal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (defgroup undo nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 "Undoing changes in buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (defgroup editing-basics nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 "Most basic editing facilities."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (defgroup display nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 "How characters are displayed in buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (defgroup installation nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 "The Emacs installation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (defgroup limits nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 "Internal Emacs limits."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 :group 'internal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (defgroup debug nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 "Debugging Emacs itself."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (defgroup mule nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 "Mule XEmacs internationalization."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 :group 'i18n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ;;; Utilities.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (defun custom-split-regexp-maybe (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 "If REGEXP is a string, split it to a list at `\\|'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 You can get the original back with from the result with:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (mapconcat #'identity result \"\\|\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 IF REGEXP is not a string, return it unchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (if (stringp regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (split-string regexp "\\\\|")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (defun custom-variable-prompt ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 ;; Code stolen from `help.el'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 "Prompt for a variable, defaulting to the variable at point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 Return a list suitable for use in `interactive'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (let ((v (variable-at-point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (enable-recursive-minibuffers t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (setq val (completing-read
4701
684f0ed6cd4f Behave better when #'variable-at-point gives nil, #'custom-variable-prompt.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4628
diff changeset
290 (if (and v (symbolp v))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (format "Customize variable: (default %s) " v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 "Customize variable: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 obarray (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (and (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (or (get symbol 'custom-type)
476
6a8b2ec80a19 [xemacs-hg @ 2001-04-18 18:18:46 by didierv]
didierv
parents: 456
diff changeset
296 (user-variable-p symbol))))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
297 t nil nil (and v (symbol-name v))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (list (if (equal val "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (if (symbolp v) v nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (intern val)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 ;; Here we take not only the actual groups, but the loads, too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (defun custom-group-prompt (prompt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 "Read group from minibuffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (let ((completion-ignore-case t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (list (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 prompt obarray
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (or (get symbol 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (get symbol 'custom-loads)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (defun custom-menu-filter (menu widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 "Convert MENU to the form used by `widget-choose'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 MENU should be in the same format as `custom-variable-menu'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 WIDGET is the widget to apply the filter entries of MENU on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (let ((result nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 current name action filter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (while menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (setq current (car menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 name (nth 0 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 action (nth 1 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 filter (nth 2 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 menu (cdr menu))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (if (or (null filter) (funcall filter widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (push (cons name action) result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (push name result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (nreverse result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 ;;; Unlispify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (defvar custom-prefix-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 "List of prefixes that should be ignored by `custom-unlispify'")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
336 (defcustom custom-save-pretty-print t
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
337 "Non-nil means pretty-print values of customized variables if available."
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
338 :group 'customize
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
339 :type 'boolean)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
340
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
341
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (defcustom custom-unlispify-menu-entries t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 "Display menu entries as words instead of symbols if non nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 :group 'custom-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (defcustom custom-unlispify-remove-prefixes t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 "Non-nil means remove group prefixes from option names in buffers and menus.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 This only has an effect when `custom-unlispify-tag-names' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 `custom-unlispify-menu-entries' is on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 :group 'custom-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 "Convert symbol into a menu entry."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (cond ((not custom-unlispify-menu-entries)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (symbol-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 ((get symbol 'custom-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (if no-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (get symbol 'custom-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (concat (get symbol 'custom-tag) "...")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (with-current-buffer (get-buffer-create " *Custom-Work*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (princ symbol (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (when (and (eq (get symbol 'custom-type) 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (re-search-forward "-p\\'" nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (replace-match "" t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (when custom-unlispify-remove-prefixes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (let ((prefixes custom-prefix-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (while prefixes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (setq prefix (car prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (if (search-forward prefix (+ (point) (length prefix)) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (setq prefixes nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (delete-region (point-min) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (setq prefixes (cdr prefixes))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (subst-char-in-region (point-min) (point-max) ?- ?\ t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (capitalize-region (point-min) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (unless no-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (insert "..."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (buffer-string)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (defcustom custom-unlispify-tag-names t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 "Display tag names as words instead of symbols if non nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 :group 'custom-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (defun custom-unlispify-tag-name (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 "Convert symbol into a menu entry."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (let ((custom-unlispify-menu-entries custom-unlispify-tag-names))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (custom-unlispify-menu-entry symbol t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (defun custom-prefix-add (symbol prefixes)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
399 ;; Add SYMBOL to list of ignored PREFIXES.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (cons (or (get symbol 'custom-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (concat (symbol-name symbol) "-"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 ;;; Guess.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (defcustom custom-guess-name-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 '(("-p\\'" boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 ("-hooks?\\'" hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ("-face\\'" face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 ("-file\\'" file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ("-function\\'" function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 ("-functions\\'" (repeat function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 ("-list\\'" (repeat sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ("-alist\\'" (repeat (cons sexp sexp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 "Alist of (MATCH TYPE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 MATCH should be a regexp matching the name of a symbol, and TYPE should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 be a widget suitable for editing the value of that symbol. The TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 of the first entry where MATCH matches the name of the symbol will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 This is used for guessing the type of variables not declared with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 customize."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (defcustom custom-guess-doc-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 '(("\\`\\*?Non-nil " boolean))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 "Alist of (MATCH TYPE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 MATCH should be a regexp matching a documentation string, and TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 should be a widget suitable for editing the value of a variable with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 that documentation string. The TYPE of the first entry where MATCH
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 matches the name of the symbol will be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 This is used for guessing the type of variables not declared with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 customize."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (defun custom-guess-type (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 "Guess a widget suitable for editing the value of SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 This is done by matching SYMBOL with `custom-guess-name-alist' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 if that fails, the doc string with `custom-guess-doc-alist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (let ((name (symbol-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (names custom-guess-name-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 current found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (while names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (setq current (car names)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 names (cdr names))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (when (string-match (nth 0 current) name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (setq found (nth 1 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 names nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (unless found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (let ((doc (documentation-property symbol 'variable-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (docs custom-guess-doc-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (when doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (while docs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (setq current (car docs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 docs (cdr docs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (when (string-match (nth 0 current) doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (setq found (nth 1 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 docs nil))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 ;;; Sorting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (defcustom custom-browse-sort-alphabetically nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 "If non-nil, sort members of each customization group alphabetically."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 :group 'custom-browse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (defcustom custom-browse-order-groups nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 "If non-nil, order group members within each customization group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 If `first', order groups before non-groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 If `last', order groups after non-groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 :type '(choice (const first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (const last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (const :tag "none" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 :group 'custom-browse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (defcustom custom-browse-only-groups nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 "If non-nil, show group members only within each customization group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 :group 'custom-browse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (defcustom custom-buffer-sort-alphabetically nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 "If non-nil, sort members of each customization group alphabetically."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (defcustom custom-buffer-order-groups 'last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 "If non-nil, order group members within each customization group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 If `first', order groups before non-groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 If `last', order groups after non-groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 :type '(choice (const first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (const last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (const :tag "none" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (defcustom custom-menu-sort-alphabetically nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 "If non-nil, sort members of each customization group alphabetically."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 :group 'custom-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (defcustom custom-menu-order-groups 'first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 "If non-nil, order group members within each customization group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 If `first', order groups before non-groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 If `last', order groups after non-groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 :type '(choice (const first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (const last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (const :tag "none" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 :group 'custom-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (defun custom-sort-items (items sort-alphabetically order-groups)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 "Return a sorted copy of ITEMS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 ITEMS should be a `custom-group' property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 If SORT-ALPHABETICALLY non-nil, sort alphabetically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 groups after non-groups, if nil do not order groups at all."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (sort (copy-sequence items)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (lambda (a b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (let ((typea (nth 1 a)) (typeb (nth 1 b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (cond ((not order-groups)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ;; Since we don't care about A and B order, maybe sort.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (when sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (string-lessp namea nameb)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 ((eq typea 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 ;; If B is also a group, maybe sort. Otherwise, order A and B.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (if (eq typeb 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (when sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (string-lessp namea nameb))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 (eq order-groups 'first)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 ((eq typeb 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 ;; Since A cannot be a group, order A and B.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (eq order-groups 'last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 ;; Since A and B cannot be groups, sort.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (string-lessp namea nameb)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 ;;; Custom Mode Commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (defvar custom-options nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 "Customization widgets in the current buffer.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (defun Custom-set ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 "Set changes in all modified options."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (let ((children custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (widget-apply child :custom-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (defun Custom-save ()
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
560 "Set all modified options and save them."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (interactive)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
562 (let ((all-children custom-options)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
563 children)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (when (memq (widget-get child :custom-state) '(modified set))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
566 (push child children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
567 all-children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
568 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
569 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
570 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
571 (widget-apply child :custom-pre-save)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
572 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
573 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
574 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
575 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
576 (widget-apply child :custom-post-save)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
577 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (defvar custom-reset-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 '(("Current" . Custom-reset-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ("Saved" . Custom-reset-saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ("Standard Settings" . Custom-reset-standard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 "Alist of actions for the `Reset' button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 The key is a string containing the name of the action, the value is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 lisp function taking the widget as an element which will be called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 when the action is chosen.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (defun custom-reset (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 "Select item from reset menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (answer (widget-choose "Reset to"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 custom-reset-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (funcall answer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (defun Custom-reset-current (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 "Reset all modified group members to their current value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (let ((children custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (widget-apply child :custom-reset-current)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (defun Custom-reset-saved (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 "Reset all modified or set group members to their saved value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (let ((children custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (widget-apply child :custom-reset-saved)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (defun Custom-reset-standard (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 "Reset all modified, set, or saved group members to their standard settings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (interactive)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
618 (let ((all-children custom-options)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
619 children must-save)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (mapc (lambda (child)
476
6a8b2ec80a19 [xemacs-hg @ 2001-04-18 18:18:46 by didierv]
didierv
parents: 456
diff changeset
621 (when (memq (widget-get child :custom-state) '(modified set saved))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
622 (push child children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
623 all-children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
624 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
625 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
626 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
627 (and (widget-apply child :custom-pre-reset-standard)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
628 (setq must-save t))))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
629 (and must-save (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
630 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
631 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
632 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
633 (widget-apply child :custom-post-reset-standard)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
634 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 ;;; The Customize Commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (defun custom-prompt-variable (prompt-var prompt-val &optional comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 "Prompt for a variable and a value and return them as a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
642 prompt for the value. A %s escape in PROMPT-VAL is replaced with
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
643 the name of the variable. A final colon is appended to both prompts.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 If the variable has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 If the variable has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 If optional COMMENT argument is non nil, also prompt for a comment and return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 it as the third element in the list."
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
653 (let* ((var (read-variable (concat prompt-var ": ")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (minibuffer-help-form '(describe-variable var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (let ((prop (get var 'variable-interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (type (get var 'custom-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (prompt (format prompt-val var)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (unless (listp type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (setq type (list type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (cond (prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 ;; Use VAR's `variable-interactive' property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 ;; as an interactive spec for prompting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (call-interactively (list 'lambda '(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (list 'interactive prop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 'arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 (widget-prompt-value type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (if (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (symbol-value var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (not (boundp var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (t
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
674 (eval-minibuffer (concat prompt ": ")))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (if comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (list var val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (read-string "Comment: " (get var 'variable-comment)))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
678 (list var val))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (defun customize-set-value (var val &optional comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 If VARIABLE has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 If given a prefix (or a COMMENT argument), also prompt for a comment."
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
691 (interactive (custom-prompt-variable "Set variable"
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
692 "Set value of %s"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (set var val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (cond ((string= comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (put var 'variable-comment nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (put var 'variable-comment comment))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 ;;;###autoload
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
702 (defun customize-set-variable (variable value &optional comment)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
703 "Set the default for VARIABLE to VALUE. VALUE is any Lisp object.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 If VARIABLE has a `custom-set' property, that is used for setting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 VARIABLE, otherwise `set-default' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 The `customized-value' property of the VARIABLE will be set to a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 with a quoted VALUE as its sole list member.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 If VARIABLE has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 If given a prefix (or a COMMENT argument), also prompt for a comment."
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
718 (interactive (custom-prompt-variable "Set variable"
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
719 "Set customized value of %s"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 current-prefix-arg))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
721 (funcall (or (get variable 'custom-set) 'set-default) variable value)
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
722 (put variable 'customized-value (list (quote-maybe value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (cond ((string= comment "")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
724 (put variable 'variable-comment nil)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
725 (put variable 'customized-variable-comment nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (comment
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
727 (put variable 'variable-comment comment)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
728 (put variable 'customized-variable-comment comment))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 ;;;###autoload
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
732 (defun customize-save-variable (variable value &optional comment)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 "Set the default for VARIABLE to VALUE, and save it for future sessions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 If VARIABLE has a `custom-set' property, that is used for setting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 VARIABLE, otherwise `set-default' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 The `customized-value' property of the VARIABLE will be set to a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 with a quoted VALUE as its sole list member.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 If VARIABLE has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 If given a prefix (or a COMMENT argument), also prompt for a comment."
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
747 (interactive (custom-prompt-variable "Set and save variable"
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
748 "Set and save value of %s"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 current-prefix-arg))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
750 (funcall (or (get variable 'custom-set) 'set-default) variable value)
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
751 (put variable 'saved-value (list (quote-maybe value)))
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
752 (custom-push-theme 'theme-value variable 'user 'set (list (quote-maybe value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (cond ((string= comment "")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
754 (put variable 'variable-comment nil)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
755 (put variable 'saved-variable-comment nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (comment
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
757 (put variable 'variable-comment comment)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
758 (put variable 'saved-variable-comment comment)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (custom-save-all))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (defun customize (group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 "Select a customization buffer which you can use to set user options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 User options are structured into \"groups\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 The default group is `Emacs'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (interactive (custom-group-prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 "Customize group: (default emacs) "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (when (stringp group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (if (string-equal "" group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (setq group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (setq group (intern group))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (let ((name (format "*Customize Group: %s*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (custom-unlispify-tag-name group))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (if (get-buffer name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (switch-to-buffer name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (custom-buffer-create (list (list group 'custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 (concat " for group "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 (custom-unlispify-tag-name group))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (defalias 'customize-group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (defun customize-other-window (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 "Customize SYMBOL, which must be a customization group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (interactive (custom-group-prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 "Customize group: (default emacs) "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (when (stringp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (if (string-equal "" symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (setq symbol 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (setq symbol (intern symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (custom-buffer-create-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (list (list symbol 'custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (defalias 'customize-group-other-window 'customize-other-window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (defalias 'customize-option 'customize-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 (defun customize-variable (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 "Customize SYMBOL, which must be a user option variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (interactive (custom-variable-prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (custom-buffer-create (list (list symbol 'custom-variable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 (format "*Customize Variable: %s*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (custom-unlispify-tag-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 (defun customize-changed-options (since-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 "Customize all user option variables whose default values changed recently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 This means, in other words, variables defined with a `:version' keyword."
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
815 (interactive
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
816 "sCustomize options changed, since version (default all versions): ")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 (if (equal since-version "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 (setq since-version nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 (and (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 (let ((version (get symbol 'custom-version)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 (and version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 (or (null since-version)
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
825 (customize-version-lessp since-version
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
826 version))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (push (list symbol 'custom-variable) found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 (unless found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 (error "No user options have changed defaults %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 (if since-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (format "since XEmacs %s" since-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 "in recent Emacs versions")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 (custom-buffer-create (custom-sort-items found t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 "*Customize Changed Options*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (defun customize-version-lessp (version1 version2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 (let (major1 major2 minor1 minor2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 (setq major1 (read (match-string 1 version1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (setq minor1 (read (match-string 2 version1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (setq major2 (read (match-string 1 version2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 (setq minor2 (read (match-string 2 version2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 (or (< major1 major2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (and (= major1 major2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (< minor1 minor2)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (defalias 'customize-variable-other-window 'customize-option-other-window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (defun customize-option-other-window (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 "Customize SYMBOL, which must be a user option variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 Show the buffer in another window, but don't select it."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (interactive (custom-variable-prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (custom-buffer-create-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 (list (list symbol 'custom-variable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
860
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
861 (defun custom-face-prompt ()
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
862 ;; Interactive call for `customize-face' and `customize-face-other-window'.
4628
877ad4697eea Fix typo in comment in cus-edit.el. <87vdqk5bqf.fsf@xemacs.org>
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4434
diff changeset
863 ;; See their docstrings for more information. Note that this call returns
877ad4697eea Fix typo in comment in cus-edit.el. <87vdqk5bqf.fsf@xemacs.org>
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4434
diff changeset
864 ;; a list of only one element. This is because the callers' second arg
877ad4697eea Fix typo in comment in cus-edit.el. <87vdqk5bqf.fsf@xemacs.org>
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4434
diff changeset
865 ;; AT-POINT is only used in interactive calls.
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
866 (let ((faces (get-char-property (point) 'face)))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
867 (if (or (null faces) (not current-prefix-arg))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
868 ;; The default behavior, which is to prompt for all faces, is also
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
869 ;; used as a fall back when a prefix is given but there's no face
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
870 ;; under point:
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
871 (let ((choice (completing-read "Customize face: (default all) "
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
872 obarray 'find-face)))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
873 (if (zerop (length choice))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
874 nil
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
875 (list (intern choice))))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
876 (cond ((symbolp faces)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
877 ;; Customize only this one:
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
878 (list (list faces)))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
879 ((listp faces)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
880 ;; Make a choice only amongst the faces under point:
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
881 (let ((choice (completing-read
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
882 "Customize face: (default all faces at point) "
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
883 (mapcar (lambda (face)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
884 (list (symbol-name face) face))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
885 faces)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
886 nil t)))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
887 (if (zerop (length choice))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
888 (list faces)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
889 (list (intern choice)))))))))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
890
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
891 (defun customize-face-1 (face custom-buffer-create-fn)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
892 ;; Customize FACE in a buffer created with BUFFER-CREATE-FN.
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
893 ;; See the docstring of `customize-face' and `customize-face-other-window'
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
894 ;; for more information.
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
895 (cond ((null face)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
896 (funcall custom-buffer-create-fn
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
897 (custom-sort-items
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
898 (mapcar (lambda (symbol)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
899 (list symbol 'custom-face))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
900 (face-list))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
901 t nil)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
902 "*Customize All Faces*"))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
903 ((listp face)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
904 (funcall custom-buffer-create-fn
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
905 (custom-sort-items
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
906 (mapcar (lambda (symbol)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
907 (list symbol 'custom-face))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
908 face)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
909 t nil)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
910 "*Customize Some Faces*"))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
911 ((symbolp face)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
912 (funcall custom-buffer-create-fn
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
913 (list (list face 'custom-face))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
914 (format "*Customize Face: %s*"
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
915 (custom-unlispify-tag-name face))))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
916 (t
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
917 (signal-error 'wrong-type-argument
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
918 '((or null listp symbolp) face)))))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
919
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 ;;;###autoload
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
922 (defun customize-face (&optional face at-point)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
923 "Open a customization buffer for FACE.
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
924 FACE should be either:
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
925 - nil, meaning to customize all faces,
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
926 - a list of symbols naming faces, meaning to customize only those,
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
927 - a symbol naming a face, meaning to customize this face only.
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
928
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
929 When called interactively, use a prefix (the AT-POINT argument) to
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
930 make a choice among the faces found at current position."
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
931 (interactive (custom-face-prompt))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
932 (customize-face-1 face #'custom-buffer-create))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
933
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
934 ;;;###autoload
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
935 (defun customize-face-other-window (&optional face at-point)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
936 "Like `customize-face', but use another window."
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
937 (interactive (custom-face-prompt))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
938 (customize-face-1 face #'custom-buffer-create-other-window))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
939
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 (defun customize-customized ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 "Customize all user options set since the last save in this session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 (and (or (get symbol 'customized-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 (get symbol 'customized-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 (find-face symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (push (list symbol 'custom-face) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (and (or (get symbol 'customized-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 (get symbol 'customized-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 (push (list symbol 'custom-variable) found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 (if (not found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (error "No customized user options")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (custom-buffer-create (custom-sort-items found t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 "*Customize Customized*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 (defun customize-saved ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 "Customize all already saved user options."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (and (or (get symbol 'saved-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 (find-face symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (push (list symbol 'custom-face) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 (and (or (get symbol 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (get symbol 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (push (list symbol 'custom-variable) found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (if (not found )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 (error "No saved user options")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 (custom-buffer-create (custom-sort-items found t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 "*Customize Saved*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 ;;;###autoload
1655
6f3d0f871934 [xemacs-hg @ 2003-08-31 01:28:00 by adrian]
adrian
parents: 848
diff changeset
980 (defalias 'apropos-customize 'customize-apropos)
6f3d0f871934 [xemacs-hg @ 2003-08-31 01:28:00 by adrian]
adrian
parents: 848
diff changeset
981
6f3d0f871934 [xemacs-hg @ 2003-08-31 01:28:00 by adrian]
adrian
parents: 848
diff changeset
982 ;;;###autoload
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (defun customize-apropos (regexp &optional all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 "Customize all user options matching REGEXP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 If ALL is `options', include only options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 If ALL is `faces', include only faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 If ALL is `groups', include only groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 If ALL is t (interactively, with prefix arg), include options which are not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 user-settable, as well as faces and groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 (interactive "sCustomize regexp: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 (when (string-match regexp (symbol-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 (when (and (not (memq all '(faces options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 (get symbol 'custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 (push (list symbol 'custom-group) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 (when (and (not (memq all '(options groups)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 (find-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 (push (list symbol 'custom-face) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (when (and (not (memq all '(groups faces)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 (or (get symbol 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 (get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 (if (memq all '(nil options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 (user-variable-p symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (get symbol 'variable-documentation))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 (push (list symbol 'custom-variable) found)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 (if (not found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (error "No matches")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (custom-buffer-create (custom-sort-items found t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 custom-buffer-order-groups)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 "*Customize Apropos*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 (defun customize-apropos-options (regexp &optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 "Customize all user options matching REGEXP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 With prefix arg, include options which are not user-settable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 (interactive "sCustomize regexp: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 (customize-apropos regexp (or arg 'options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 (defun customize-apropos-faces (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 "Customize all user faces matching REGEXP."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 (interactive "sCustomize regexp: \n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 (customize-apropos regexp 'faces))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 (defun customize-apropos-groups (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 "Customize all user groups matching REGEXP."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 (interactive "sCustomize regexp: \n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 (customize-apropos regexp 'groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 ;;; Buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 (defcustom custom-buffer-style 'links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 "*Control the presentation style for customization buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 The value should be a symbol, one of:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 brackets: groups nest within each other with big horizontal brackets.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 links: groups have links to subgroups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 :type '(radio (const :tag "brackets: Groups nest within each others" brackets)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 (const :tag "links: Group have links to subgroups" links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 (defcustom custom-buffer-done-function 'kill-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 "*Function to be used to remove the buffer when the user is done with it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 Choices include `kill-buffer' (the default) and `bury-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 The function will be called with one argument, the buffer to remove."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 :type '(radio (function-item kill-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 (function-item bury-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 (function :tag "Other" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (defcustom custom-buffer-indent 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 "Number of spaces to indent nested groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 (defun custom-buffer-create (options &optional name description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 "Create a buffer containing OPTIONS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 Optional NAME is the name of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 SYMBOL is a customization option, and WIDGET is a widget for editing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 that option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 (unless name (setq name "*Customization*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 (kill-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 (switch-to-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (custom-buffer-create-internal options description))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (defun custom-buffer-create-other-window (options &optional name description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 "Create a buffer containing OPTIONS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 Optional NAME is the name of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 SYMBOL is a customization option, and WIDGET is a widget for editing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 that option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 (unless name (setq name "*Customization*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 (kill-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 (let ((window (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 (switch-to-buffer-other-window (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 (custom-buffer-create-internal options description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 (select-window window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (defcustom custom-reset-button-menu t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 "If non-nil, only show a single reset button in customize buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 This button will have a menu with all three reset operations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (defconst custom-skip-messages 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (defun Custom-buffer-done ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 "Remove current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 This works by calling the function specified by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 `custom-buffer-done-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 (funcall custom-buffer-done-function (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 (defun custom-buffer-create-buttons ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 (message "Creating customization buttons...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 (widget-insert "\nOperate on everything in this buffer:\n ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 :tag "Set"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 Make your editing in this buffer take effect for this session"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 (Custom-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 :tag "Save"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 Make your editing in this buffer take effect for future Emacs sessions"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (Custom-save)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (if custom-reset-button-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 :tag "Reset"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 :tag-glyph '("reset-up" "reset-down")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 :help-echo "Show a menu with reset operations"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 :mouse-down-action (lambda (&rest junk) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 (custom-reset event))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 :tag "Reset"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 Reset all edited text in this buffer to reflect current values"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 :action 'Custom-reset-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 :tag "Reset to Saved"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 Reset all values in this buffer to their saved settings"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 :action 'Custom-reset-saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 :tag "Reset to Standard"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 Reset all values in this buffer to their standard settings"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 :action 'Custom-reset-standard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 :tag "Done"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 :help-echo "Remove the buffer"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 (Custom-buffer-done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 (defcustom custom-novice t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 "If non-nil, show help message at top of customize buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 (defcustom custom-display-global-buttons 'top
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 "If `nil' don't display the global buttons. If `top' display at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 beginning of custom buffers. If `bottom', display at the end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 :type '(choice (const top)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (const bottom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 (const :tag "don't" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 (defun custom-buffer-create-internal (options &optional description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 (message "Creating customization buffer...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 (custom-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 (widget-insert "This is a customization buffer")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 (if description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 (widget-insert description))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 (when custom-novice
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 (widget-insert ".\n\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 Type RET or click button2 on an active field to invoke its action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 Invoke ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 (widget-create 'info-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 :tag "Help"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 :help-echo "Read the online help"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 "(XEmacs)Easy Customization")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 (widget-insert " for more information."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 (widget-insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 (if (equal custom-display-global-buttons 'top)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 (custom-buffer-create-buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 (widget-insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 (message "Creating customization items...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 (setq custom-options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 (if (= (length options) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 (mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 (widget-create (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 :documentation-shown t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 :custom-state 'unknown
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 :tag (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 :value (nth 0 entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 options)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 (let ((count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 (length (length options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 (mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 (prog2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 'progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 (format "Creating customization items %2d%%..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 (/ (* 100.0 count) length)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 (widget-create (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 :tag (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 :value (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 (incf count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 (widget-insert "\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 options))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 (if (equal custom-display-global-buttons 'bottom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 (custom-buffer-create-buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 (display-message 'progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 "Creating customization items %2d%%...done" 100))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 (unless (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 (mapc 'custom-magic-reset custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 (message "Creating customization setup...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 (widget-setup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 (message "Creating customization buffer...done"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 ;;; The Tree Browser.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 (defun customize-browse (&optional group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 "Create a tree browser for the customize hierarchy."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 (unless group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 (setq group 'emacs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 (let ((name "*Customize Browser*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 (kill-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 (switch-to-buffer (get-buffer-create name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 (custom-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 (widget-insert "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 Square brackets show active fields; type RET or click button2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 on an active field to invoke its action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 (if custom-browse-only-groups
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 (widget-insert "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 Invoke the [Group] button below to edit that item in another window.\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 (widget-insert "Invoke the ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 (widget-create 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 :format "%t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 :tag "[Group]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 :tag-glyph "folder")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 (widget-insert ", ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 (widget-create 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 :format "%t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 :tag "[Face]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 :tag-glyph "face")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 (widget-insert ", and ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 (widget-create 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 :format "%t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 :tag "[Option]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 :tag-glyph "option")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (widget-insert " buttons below to edit that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 item in another window.\n\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 (let ((custom-buffer-style 'tree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 (widget-create 'custom-group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 :custom-last t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 :custom-state 'unknown
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 :tag (custom-unlispify-tag-name group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 :value group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 (widget-add-change)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 (define-widget 'custom-browse-visibility 'item
2118
e28998a020ec [xemacs-hg @ 2004-06-07 21:50:57 by adrian]
adrian
parents: 1655
diff changeset
1274 "Control visibility of items in the customize tree browser."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 :format "%[[%t]%]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 :action 'custom-browse-visibility-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 (defun custom-browse-visibility-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 (let ((custom-buffer-style 'tree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 (custom-toggle-parent widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 (define-widget 'custom-browse-group-tag 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 :tag "Group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 :tag-glyph "folder"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 :action 'custom-browse-group-tag-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 (defun custom-browse-group-tag-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (let ((parent (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 (customize-group-other-window (widget-value parent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 (define-widget 'custom-browse-variable-tag 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 :tag "Option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 :tag-glyph "option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 :action 'custom-browse-variable-tag-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 (defun custom-browse-variable-tag-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 (let ((parent (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 (customize-variable-other-window (widget-value parent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 (define-widget 'custom-browse-face-tag 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 :tag "Face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 :tag-glyph "face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 :action 'custom-browse-face-tag-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 (defun custom-browse-face-tag-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 (let ((parent (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 (customize-face-other-window (widget-value parent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 (defconst custom-browse-alist '((" " "space")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 (" | " "vertical")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 ("-\\ " "top")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 (" |-" "middle")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 (" `-" "bottom")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 (defun custom-browse-insert-prefix (prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 "Insert PREFIX. On XEmacs convert it to line graphics."
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1320 ;; #### Unfinished.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 (if nil ; (string-match "XEmacs" emacs-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 (insert "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (while (not (string-equal prefix ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 (let ((entry (substring prefix 0 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 (setq prefix (substring prefix 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 (name (nth 1 (assoc entry custom-browse-alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 (overlay-put overlay 'start-open t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (overlay-put overlay 'end-open t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (insert prefix)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 ;;; Modification of Basic Widgets.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 ;; We add extra properties to the basic widgets needed here. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 ;; fine, as long as we are careful to stay within out own namespace.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 ;; We want simple widgets to be displayed by default, but complex
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 ;; widgets to be hidden.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 (widget-put (get 'item 'widget-type) :custom-show t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 (widget-put (get 'editable-field 'widget-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 :custom-show (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 ;; This used to call pp-to-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 (let ((pp (widget-prettyprint-to-string value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 (cond ((string-match "\n" pp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 ((> (length pp) 40)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 (t t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 (widget-put (get 'menu-choice 'widget-type) :custom-show t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 ;;; The `custom-manual' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 (define-widget 'custom-manual 'info-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 "Link to the manual entry for this customization option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 :tag "Manual")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 ;;; The `custom-magic' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 (defgroup custom-magic-faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 "Faces used by the magic button."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 :group 'custom-faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 (defface custom-invalid-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 (:foreground "yellow" :background "red"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 (:bold t :italic t :underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 "Face used when the customize item is invalid."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 (defface custom-rogue-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 (:foreground "pink" :background "black"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 "Face used when the customize item is not defined for customization."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 (defface custom-modified-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 (:foreground "white" :background "blue"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 (:italic t :bold)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 "Face used when the customize item has been modified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 (defface custom-set-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 (:foreground "blue" :background "white"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 (:italic t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 "Face used when the customize item has been set."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 (defface custom-changed-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 (:foreground "white" :background "blue"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 (:italic t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 "Face used when the customize item has been changed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 (defface custom-saved-face '((t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 "Face used when the customize item has been saved."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 (defconst custom-magic-alist '((nil "#" underline "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 uninitialized, you should not see this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 (unknown "?" italic "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 unknown, you should not see this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 (hidden "-" default "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 hidden, invoke \"Show\" button in the previous line to show." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 group now hidden, invoke the above \"Show\" button to show contents.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 (invalid "x" custom-invalid-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 the value displayed for this %c is invalid and cannot be set.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 (modified "*" custom-modified-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 you have edited the value as text, but you have not set the %c." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 you have edited something in this group, but not set it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 (set "+" custom-set-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 you have set this %c, but not saved it for future sessions." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 something in this group has been set, but not saved.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 (changed ":" custom-changed-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 this %c has been changed outside the customize buffer." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 something in this group has been changed outside customize.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 (saved "!" custom-saved-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 this %c has been set and saved." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 something in this group has been set and saved.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 (rogue "@" custom-rogue-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 this %c has not been changed with customize." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 something in this group is not prepared for customization.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 (standard " " nil "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 this %c is unchanged from its standard setting." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 visible group members are all at standard settings."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 "Alist of customize option states.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 STATE is one of the following symbols:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 For internal use, should never occur.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 `unknown'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 For internal use, should never occur.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 `hidden'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 This item is not being displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 `invalid'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 This item is modified, but has an invalid form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 `modified'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 This item is modified, and has a valid form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 `set'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 This item has been set but not saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 `changed'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 The current value of this item has been changed temporarily.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 `saved'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 This item is marked for saving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 `rogue'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 This item has no customization information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 `standard'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 This item is unchanged from the standard setting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 MAGIC is a string used to present that state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 FACE is a face used to present the state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 ITEM-DESC is a string describing the state for options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 GROUP-DESC is a string describing the state for groups. If this is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 left out, ITEM-DESC will be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 The string %c in either description will be replaced with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 category of the item. These are `group'. `option', and `face'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 The list should be sorted most significant first.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 (defcustom custom-magic-show 'long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 "If non-nil, show textual description of the state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 If `long', show a full-line description, not just one word."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 :type '(choice (const :tag "no" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 (const short)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 (const long))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 (defcustom custom-magic-show-hidden '(option face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 "Control whether the State button is shown for hidden items.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 The value should be a list with the custom categories where the State
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 button should be visible. Possible categories are `group', `option',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 and `face'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 :type '(set (const group) (const option) (const face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 (defcustom custom-magic-show-button nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 "Show a \"magic\" button indicating the state of each customization option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 (define-widget 'custom-magic 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 "Show and manipulate state for a customization option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 :action 'widget-parent-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 :notify 'ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 :value-get 'ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 :value-create 'custom-magic-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 :value-delete 'widget-children-value-delete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 (defun widget-magic-mouse-down-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 ;; Non-nil unless hidden.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 :custom-state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (defun custom-magic-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 ;; Create compact status report for WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 (let* ((parent (widget-get widget :parent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 (state (widget-get parent :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 (hidden (eq state 'hidden))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 (entry (assq state custom-magic-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 (magic (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 (face (nth 2 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 (category (widget-get parent :custom-category))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 (text (or (and (eq category 'group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 (nth 4 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 (nth 3 entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 (form (widget-get parent :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 (setq text (concat (match-string 1 text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 (symbol-name category)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 (match-string 2 text))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 (when (and custom-magic-show
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 (or (not hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 (memq category custom-magic-show-hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 (when (and (eq category 'group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 (not (and (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 (> (widget-get parent :custom-level) 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 (insert-char ?\ (* custom-buffer-indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 (widget-get parent :custom-level))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 widget 'choice-item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 :help-echo "Change the state of this item"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 :format (if hidden "%t" "%[%t%]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 :button-prefix 'widget-push-button-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 :button-suffix 'widget-push-button-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 :mouse-down-action 'widget-magic-mouse-down-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 :tag "State"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 ;;:tag-glyph (or hidden '("state-up" "state-down"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 (insert ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 (let ((start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 (if (eq custom-magic-show 'long)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 (insert text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 (insert (symbol-name state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 (cond ((eq form 'lisp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 (insert " (lisp)"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 ((eq form 'mismatch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 (insert " (mismatch)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 (put-text-property start (point) 'face 'custom-state-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 (insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 (when (and (eq category 'group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 (not (and (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 (> (widget-get parent :custom-level) 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 (insert-char ?\ (* custom-buffer-indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 (widget-get parent :custom-level))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 (when custom-magic-show-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 (when custom-magic-show
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 (let ((indent (widget-get parent :indent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 (when indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 (insert-char ?\ indent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 widget 'choice-item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 :mouse-down-action 'widget-magic-mouse-down-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 :button-face face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 :button-prefix ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 :button-suffix ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 :help-echo "Change the state"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 :format (if hidden "%t" "%[%t%]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 :tag (if (memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 (concat "(" magic ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 (concat "[" magic "]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (insert " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 (widget-put widget :children children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 (defun custom-magic-reset (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 "Redraw the :custom-magic property of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 (let ((magic (widget-get widget :custom-magic)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 (widget-value-set magic (widget-value magic))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 ;;; The `custom' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 (defface custom-button-face '((t (:bold t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 "Face used for buttons in customization buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 (defface custom-documentation-face nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 "Face used for documentation strings in customization buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 (defface custom-state-face '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 (:foreground "lime green"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 (:foreground "dark green"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 (t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 "Face used for State descriptions in the customize buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (define-widget 'custom 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 "Customize a user option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 :convert-widget 'custom-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 :notify 'custom-notify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 :custom-prefix ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 :custom-level 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 :custom-state 'hidden
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 :documentation-property 'widget-subclass-responsibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 :value-create 'widget-subclass-responsibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 :value-delete 'widget-children-value-delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 :value-get 'widget-value-value-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 :validate 'widget-children-validate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 :match (lambda (widget value) (symbolp value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 (defun custom-convert-widget (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 ;; Initialize :value and :tag from :args in WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (let ((args (widget-get widget :args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 (when args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 (widget-put widget :value (widget-apply widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 :value-to-internal (car args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 (widget-put widget :tag (custom-unlispify-tag-name (car args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 (widget-put widget :args nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 (defun custom-notify (widget &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 "Keep track of changes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 (let ((state (widget-get widget :custom-state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 (unless (eq state 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 (unless (memq state '(nil unknown hidden))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 (widget-put widget :custom-state 'modified))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 (custom-magic-reset widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 (apply 'widget-default-notify widget args))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 (defun custom-redraw (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 "Redraw WIDGET with current settings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 (let ((line (count-lines (point-min) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 (column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 (pos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 (from (marker-position (widget-get widget :from)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 (to (marker-position (widget-get widget :to))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 (widget-value-set widget (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 (custom-redraw-magic widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 (when (and (>= pos from) (<= pos to))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 (if (> column 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 (goto-line line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 (goto-line (1+ line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 (move-to-column column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 (error nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 (defun custom-redraw-magic (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 "Redraw WIDGET state with current settings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 (while widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 (let ((magic (widget-get widget :custom-magic)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 (cond (magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 (widget-value-set magic (widget-value magic))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 (when (setq widget (widget-get widget :group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 (custom-group-state-update widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 (setq widget nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 (widget-setup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 (defun custom-show (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 "Non-nil if WIDGET should be shown with VALUE by default."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 (let ((show (widget-get widget :custom-show)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 (cond ((null show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 ((eq t show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 (funcall show widget value)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 (defvar custom-load-recursion nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 "Hack to avoid recursive dependencies.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 (defun custom-load-symbol (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 "Load all dependencies for SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 (unless custom-load-recursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 (let ((custom-load-recursion t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 (loads (get symbol 'custom-loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 (while loads
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 (setq load (car loads)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 loads (cdr loads))
2544
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1696 (custom-load-symbol-1 load)))))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1697
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1698 (defun custom-load-symbol-1 (load)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1699 (cond ((symbolp load)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1700 (condition-case nil
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1701 (require load)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1702 (error nil)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1703 ;; Don't reload a file already loaded.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1704 ((and (boundp 'preloaded-file-list)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1705 (member load preloaded-file-list)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1706 ((assoc load load-history))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1707 ((assoc (locate-library load) load-history))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1708 (t
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1709 (condition-case nil
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1710 ;; Without this, we would load cus-edit recursively.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1711 ;; We are still loading it when we call this,
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1712 ;; and it is not in load-history yet.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1713 (or (equal load "cus-edit")
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1714 (load-library load))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1715 (error nil)))))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1716
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1717 (defvar custom-already-loaded-custom-defines nil
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1718 "List of already-loaded `custom-defines' files.")
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1719 (defvar custom-define-current-source-file nil)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1720 (defvar custom-warn-when-reloading-necessary nil
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1721 "For package-debugging purposes: Warn when an error hit in custom-defines.el.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1722 When this happens, the file from which the defcustom or defgroup was taken
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1723 is loaded, and custom-defines.el is then reloaded. This works in most
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1724 cases, but may not be completely safe. It's better if the package itself
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1725 arranges for the necessary functions and variables to be available, using
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1726 \;;;###autoload declarations. When this variable is non-nil, warnings are
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1727 issued (with backtrace), to aid in tracking down the problems.")
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1728
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1729 (defun custom-load-custom-defines (symbol)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1730 "Load custom-defines for SYMBOL."
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1731 (unless custom-load-recursion
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1732 (let ((custom-load-recursion t)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1733 (loads (get symbol 'custom-loads))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1734 load)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1735 (while loads
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1736 (setq load (car loads)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1737 loads (cdr loads))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1738 (let* ((found (locate-library
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1739 (if (symbolp load) (symbol-name load) load)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1740 (dir (and found (file-name-directory found))))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1741 ;; If we find a custom-defines file, assume the package is smart
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1742 ;; enough to have put all its defcustoms and defgroups here, and
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1743 ;; load it instead of the file itself. Otherwise, do it the
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1744 ;; hard way.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1745 (if (and found (or (file-exists-p
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1746 (expand-file-name "custom-defines.elc" dir))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1747 (file-exists-p
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1748 (expand-file-name "custom-defines.el" dir))))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1749 (when (not (member dir custom-already-loaded-custom-defines))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1750 (push dir custom-already-loaded-custom-defines)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1751 (custom-load-custom-defines-1 dir))))))))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1752
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1753 (defun custom-load-custom-defines-1 (dir)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1754 ;; Actually load the custom-defines.el file in DIR.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1755
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1756 ;; If we get an error loading the custom-defines, it may be because of a
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1757 ;; reference to something (e.g. a constant) that hasn't yet been defined
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1758 ;; yet. Properly, these should have been marked, so they either go into
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1759 ;; the custom-defines.el file or are autoloaded. But not everyone is so
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1760 ;; careful, so for the moment we try to load the file that the
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1761 ;; error-generating defcustom came from, and then reload the
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1762 ;; custom-defines.el file. We might loop a number of times if we have
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1763 ;; various files that need loading. If at any point we get an error that
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1764 ;; can't be solved just by loading the appropriate file (e.g. we hit the
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1765 ;; same error as before, the file is already loaded, etc.) then we signal
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1766 ;; it as a real error.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1767 (let (source)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1768 ;; here's how this works: if we get an error loading custom-defines,
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1769 ;; the condition handler is called; if we need to reload, we
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1770 ;; `return-from', which throws out of the handler and returns nil from
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1771 ;; the `block', which continues the while statement, executing the
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1772 ;; `load' at the bottom of this function and then entering the block
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1773 ;; again. if the condition handler doesn't throw, but instead returns
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1774 ;; normally, `signal' will continue as if nothing happened, and end up
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1775 ;; signalling the error normally.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1776 (while
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1777 (not
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1778 (block custom-load
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1779 ;; Use call-with-condition-handler so the error can be seen
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1780 ;; with the stack intact.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1781 (call-with-condition-handler
4806
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1782 ((macro
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1783 . (lambda (lambda-expression)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1784 ;; Be more serious about information hiding here:
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1785 (nsublis
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1786 '((custom-load-handler-arg . #:custom-load-g9JBHiZHD))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1787 lambda-expression)))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1788 #'(lambda (custom-load-handler-arg)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1789 (when (and
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1790 custom-define-current-source-file
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1791 (progn
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1792 (setq source (expand-file-name
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1793 custom-define-current-source-file
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1794 dir))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1795 (let ((nondir (file-name-nondirectory source)))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1796 (and (file-exists-p source)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1797 (not (assoc source load-history))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1798 (not (assoc nondir load-history))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1799 (not (and (boundp 'preloaded-file-list)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1800 (member nondir
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1801 preloaded-file-list)))))))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1802 (if custom-warn-when-reloading-necessary
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1803 (lwarn 'custom-defines 'warning
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1804 "Error while loading custom-defines, fetching \
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1805 source and reloading ...\n
2544
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1806 Error: %s\n
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1807 Source file: %s\n\n
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1808 Backtrace follows:\n\n%s"
4806
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1809 (error-message-string custom-load-handler-arg)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1810 source
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1811 (backtrace-in-condition-handler-eliminating-handler
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1812 'custom-load-handler-arg
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1813 )))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4744
diff changeset
1814 (return-from custom-load nil))))
2544
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1815 #'(lambda ()
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1816 (load (expand-file-name "custom-defines" dir))))))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
1817 ;; we get here only from the `return-from'; see above
2544
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
1818 (load source))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 (defun custom-load-widget (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 "Load all dependencies for WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 (custom-load-symbol (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 (defun custom-unloaded-symbol-p (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 "Return non-nil if the dependencies of SYMBOL has not yet been loaded."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 (let ((found nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 (loads (get symbol 'custom-loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 (while loads
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 (setq load (car loads)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 loads (cdr loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 (cond ((symbolp load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 (unless (featurep load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 (setq found t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 ((assoc load load-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 ((assoc (locate-library load) load-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 ;; #### WTF???
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 (message nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 (setq found t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 (defun custom-unloaded-widget-p (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 "Return non-nil if the dependencies of WIDGET has not yet been loaded."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 (custom-unloaded-symbol-p (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 (defun custom-toggle-hide (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 "Toggle visibility of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 (let ((state (widget-get widget :custom-state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 (cond ((memq state '(invalid modified))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 (error "There are unset changes"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 (widget-put widget :custom-state 'unknown))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 (widget-put widget :documentation-shown nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 (widget-put widget :custom-state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 (custom-redraw widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 (widget-setup)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 (defun custom-toggle-parent (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 "Toggle visibility of parent of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 (custom-toggle-hide (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 (defun custom-add-see-also (widget &optional prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 "Add `See also ...' to WIDGET if there are any links.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 Insert PREFIX first if non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 (let* ((symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 (links (get symbol 'custom-links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 (many (> (length links) 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 (buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 (indent (widget-get widget :indent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 (when links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 (when indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 (insert-char ?\ indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 (when prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 (insert prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 (insert "See also ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 (while links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 (push (widget-create-child-and-convert widget (car links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 (setq links (cdr links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 (cond ((null links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 (insert ".\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 ((null (cdr links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 (if many
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 (insert ", and ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 (insert " and ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 (insert ", "))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 (widget-put widget :buttons buttons))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 (defun custom-add-parent-links (widget &optional initial-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 "Add \"Parent groups: ...\" to WIDGET if the group has parents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 The value if non-nil if any parents were found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 (let ((name (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 (type (widget-type widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 (buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 (start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 (insert (or initial-string "Parent groups:"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 (maphash (lambda (group ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 (let ((entry (assq name (get group 'custom-group))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 (when (eq (nth 1 entry) type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 widget 'custom-group-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 :tag (custom-unlispify-tag-name group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 (setq found t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 custom-group-hash-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 (if found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 (delete-region start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 ;;; The `custom-comment' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 ;; like the editable field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 (defface custom-comment-face '((((class grayscale color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 (:background "gray85"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 (((class grayscale color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 (:background "dim gray"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 (:italic t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 "Face used for comments on variables or faces"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 ;; like font-lock-comment-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 (defface custom-comment-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 '((((class color) (background dark)) (:foreground "gray80"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 (((class color) (background light)) (:foreground "blue4"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 (((class grayscale) (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 (:foreground "DimGray" :bold t :italic t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 (((class grayscale) (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 (:foreground "LightGray" :bold t :italic t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 (t (:bold t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 "Face used for variables or faces comment tags"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 (define-widget 'custom-comment 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 "User comment"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 :tag "Comment"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 :help-echo "Edit a comment here"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 :sample-face 'custom-comment-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 :value-face 'custom-comment-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 :value-set 'custom-comment-value-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 :create 'custom-comment-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 :delete 'custom-comment-delete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 (defun custom-comment-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 (let (ext)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 (widget-default-create widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 (widget-put widget :comment-extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 (setq ext (make-extent (widget-get widget :from)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 (widget-get widget :to))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 (set-extent-property ext 'start-open t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 (when (equal (widget-get widget :value) "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 (set-extent-property ext 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 (defun custom-comment-delete (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 (widget-default-delete widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 (delete-extent (widget-get widget :comment-extent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 (defun custom-comment-value-set (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 (widget-default-value-set widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 (if (equal value "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 (set-extent-property (widget-get widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 'invisible t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 (set-extent-property (widget-get widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 'invisible nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 ;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 ;; the global custom one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 (defun custom-comment-show (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 (set-extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 (widget-get (widget-get widget :comment-widget) :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 'invisible nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 (defun custom-comment-invisible-p (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 (extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 (widget-get (widget-get widget :comment-widget) :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 ;;; The `custom-variable' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 (defface custom-variable-tag-face '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 (:foreground "light blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 (:foreground "blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 (t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 "Face used for unpushable variable tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 (defface custom-variable-button-face '((t (:underline t :bold t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 "Face used for pushable variable tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 (defcustom custom-variable-default-form 'edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 "Default form of displaying variable values."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 :type '(choice (const edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 (const lisp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 (define-widget 'custom-variable 'custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 "Customize variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 :help-echo "Set or reset this variable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 :documentation-property 'variable-documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 :custom-category 'option
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 :custom-state nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 :custom-menu 'custom-variable-menu-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 :custom-form nil ; defaults to value of `custom-variable-default-form'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 :value-create 'custom-variable-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 :action 'custom-variable-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 :custom-set 'custom-variable-set
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2025 :custom-pre-save 'custom-variable-pre-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 :custom-save 'custom-variable-save
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2027 :custom-post-save 'custom-variable-post-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 :custom-reset-current 'custom-redraw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 :custom-reset-saved 'custom-variable-reset-saved
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2030 :custom-pre-reset-standard 'custom-variable-pre-reset-standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2031 :custom-reset-standard 'custom-variable-reset-standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2032 :custom-post-reset-standard 'custom-variable-post-reset-standard)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 (defun custom-variable-type (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 "Return a widget suitable for editing the value of SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 If SYMBOL has a `custom-type' property, use that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 Otherwise, look up symbol in `custom-guess-type-alist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 (let* ((type (or (get symbol 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 (and (not (get symbol 'standard-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 (custom-guess-type symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 'sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 (options (get symbol 'custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 (tmp (if (listp type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 (copy-sequence type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 (list type))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 (when options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 (widget-put tmp :options options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 (defun custom-variable-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 "Here is where you edit the variables value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 (unless (widget-get widget :custom-form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 (widget-put widget :custom-form custom-variable-default-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 (let* ((buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 (children (widget-get widget :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 (form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 (symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 (tag (widget-get widget :tag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 (type (custom-variable-type symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 (conv (widget-convert type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 (get (or (get symbol 'custom-get) 'default-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 (prefix (widget-get widget :custom-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 (last (widget-get widget :custom-last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 (value (if (default-boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 (funcall get symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 (widget-get conv :value))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 ;; If the widget is new, the child determine whether it is hidden.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 (cond (state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 ((custom-show type value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 (setq state 'unknown))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 (setq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 ;; If we don't know the state, see if we need to edit it in lisp form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 (when (eq state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 (unless (widget-apply conv :match value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 ;; (widget-apply (widget-convert type) :match value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 (setq form 'mismatch)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 ;; Now we can create the child widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 (cond ((eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 (insert prefix (if last " `--- " " |--- "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 widget 'custom-browse-variable-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 ;; Indicate hidden value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 widget 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 :format "%{%t%}: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 :sample-face 'custom-variable-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 :tag tag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 :parent widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 :help-echo "Show the value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 ((memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 ;; In lisp mode edit the saved value when possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 (let* ((value (cond ((get symbol 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 (car (get symbol 'saved-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 ((get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 (car (get symbol 'standard-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 ((default-boundp symbol)
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2110 (quote-maybe (funcall get symbol)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 (t
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2112 (quote-maybe (widget-get conv :value))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 (insert (symbol-name symbol) ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 :help-echo "Hide the value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 widget 'sexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 :button-face 'custom-variable-button-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 :tag (symbol-name symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 :parent widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 :value value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 ;; Edit mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 (let* ((format (widget-get type :format))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 tag-format value-format)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 (while (not (string-match ":" format))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 (setq format (signal 'error (list "Bad format" format))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 (setq tag-format (substring format 0 (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 (setq value-format (substring format (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 widget 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 :format tag-format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 :action 'custom-tag-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 :help-echo "Change value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 :mouse-down-action 'custom-tag-mouse-down-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 :button-face 'custom-variable-button-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 :sample-face 'custom-variable-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 :help-echo "Hide the value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 widget type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 :format value-format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 :value value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 children))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 (unless (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 ;; Create the magic button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 widget 'custom-magic nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 ;; Insert documentation.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2168 ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 ;; before the call to `widget-default-format-handler'. Otherwise, I
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2170 ;; lose my current `buttons'. This function shouldn't be called like
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 ;; this anyway. The doc string widget should be added like the others.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 ;; --dv
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 (widget-default-format-handler widget ?h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 ;; The comment field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 (let* ((comment (get symbol 'variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 (comment-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 widget 'custom-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 :parent widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 :value (or comment ""))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 (widget-put widget :comment-widget comment-widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 ;; Don't push it !!! Custom assumes that the first child is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 ;; value one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 (setq children (append children (list comment-widget)))))
2118
e28998a020ec [xemacs-hg @ 2004-06-07 21:50:57 by adrian]
adrian
parents: 1655
diff changeset
2187 ;; Update the rest of the properties.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 (widget-put widget :custom-form form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 (widget-put widget :children children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 ;; Now update the state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 (if (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 (widget-put widget :custom-state state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 (custom-variable-state-set widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 ;; See also.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 (when (eq (widget-get widget :custom-level) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 (custom-add-parent-links widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 (custom-add-see-also widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 (defun custom-tag-action (widget &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 "Pass :action to first child of WIDGET's parent."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 :action args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 (defun custom-tag-mouse-down-action (widget &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 "Pass :mouse-down-action to first child of WIDGET's parent."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 :mouse-down-action args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 (defun custom-variable-state-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 "Set the state of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 (get (or (get symbol 'custom-get) 'default-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 (value (if (default-boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 (funcall get symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 (widget-get widget :value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 (comment (get symbol 'variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 tmp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 (state (cond ((progn (setq tmp (get symbol 'customized-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 (setq temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 (get symbol 'customized-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 (if (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 (and (equal value (eval (car tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 (equal comment temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 'set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 ((progn (setq tmp (get symbol 'saved-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 (setq temp (get symbol 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 (if (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 (and (equal value (eval (car tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 (equal comment temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 'saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 ((setq tmp (get symbol 'standard-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 (if (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 (and (equal value (eval (car tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 (equal comment nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 'standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 (t 'rogue))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 (widget-put widget :custom-state state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 (defvar custom-variable-menu
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2250 `(("Set for Current Session" custom-variable-set
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2251 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2252 (eq (widget-get widget :custom-state) 'modified)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 ("Save for Future Sessions" custom-variable-save
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2254 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2255 (memq (widget-get widget :custom-state)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2256 '(modified set changed rogue))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 ("Reset to Current" custom-redraw
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2258 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2259 (and (default-boundp (widget-value widget))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2260 (memq (widget-get widget :custom-state) '(modified changed)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 ("Reset to Saved" custom-variable-reset-saved
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2262 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2263 (and (or (get (widget-value widget) 'saved-value)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2264 (get (widget-value widget) 'saved-variable-comment))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2265 (memq (widget-get widget :custom-state)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2266 '(modified set changed rogue)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 ("Reset to Standard Settings" custom-variable-reset-standard
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2268 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2269 (and (get (widget-value widget) 'standard-value)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2270 (memq (widget-get widget :custom-state)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2271 '(modified set changed saved rogue)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 ("Add Comment" custom-comment-show custom-comment-invisible-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 ("Don't show as Lisp expression" custom-variable-edit
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2276 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2277 (eq (widget-get widget :custom-form) 'lisp)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 ("Show as Lisp expression" custom-variable-edit-lisp
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2279 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2280 (eq (widget-get widget :custom-form) 'edit))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 "Alist of actions for the `custom-variable' widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 the menu entry, ACTION is the function to call on the widget when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 menu is selected, and FILTER is a predicate which takes a `custom-variable'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 widget as an argument, and returns non-nil if ACTION is valid on that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 widget. If FILTER is nil, ACTION is always valid.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 (defun custom-variable-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 "Show the menu for `custom-variable' WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 Optional EVENT is the location for the menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 (if (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 (custom-toggle-hide widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 (unless (eq (widget-get widget :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 (custom-variable-state-set widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 ;; Redrawing magic also depresses the state glyph.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 ;(custom-redraw-magic widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 (answer (widget-choose (concat "Operation on "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 (widget-get widget :value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 (custom-menu-filter custom-variable-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 (funcall answer widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 (defun custom-variable-edit (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 "Edit value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 (widget-put widget :custom-form 'edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 (defun custom-variable-edit-lisp (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 "Edit the lisp representation of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 (widget-put widget :custom-form 'lisp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 (defun custom-variable-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 "Set the current value for the variable being edited by WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 (let* ((form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 (symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 (set (or (get symbol 'custom-set) 'set-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 (comment (widget-value comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 (cond ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 (error "Cannot set hidden variable"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 ((setq val (widget-apply child :validate))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 (goto-char (widget-get val :from))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 (error "%s" (widget-get val :error)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 ((memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 (funcall set symbol (eval (setq val (widget-value child))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 (put symbol 'customized-value (list val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 (put symbol 'customized-variable-comment comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 (funcall set symbol (setq val (widget-value child)))
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2351 (put symbol 'customized-value (list (quote-maybe val)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 (put symbol 'customized-variable-comment comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 (custom-variable-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 (custom-redraw-magic widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2357 (defun custom-variable-pre-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2358 "Prepare for saving the value for the variable being edited by WIDGET."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 (let* ((form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 (symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 (set (or (get symbol 'custom-set) 'set-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 (comment (widget-value comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 (cond ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 (error "Cannot set hidden variable"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 ((setq val (widget-apply child :validate))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 (goto-char (widget-get val :from))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 (error "%s" (widget-get val :error)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 ((memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 (put symbol 'saved-value (list (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 (custom-push-theme 'theme-value symbol 'user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 'set (list (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 (funcall set symbol (eval (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 (put symbol 'saved-variable-comment comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 (put symbol
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2391 'saved-value (list (quote-maybe (widget-value
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2392 child))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 (custom-push-theme 'theme-value symbol 'user
4744
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2394 'set (list (quote-maybe (widget-value
17f7e9191c0b Rationalise duplicated functionality, #'custom-quote, #'quote-maybe.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4701
diff changeset
2395 child))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 (funcall set symbol (widget-value child))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 (put symbol 'saved-variable-comment comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 (put symbol 'customized-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 (put symbol 'customized-variable-comment nil)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2401 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2402
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2403 (defun custom-variable-post-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2404 "Finish saving the variable being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2405 (custom-variable-state-set widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2406 (custom-redraw-magic widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2407
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2408 (defun custom-variable-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2409 "Set and save the value for the variable being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2410 (custom-variable-pre-save widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2411 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2412 (custom-variable-post-save widget))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 (defun custom-variable-reset-saved (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 "Restore the saved value for the variable being edited by WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 (set (or (get symbol 'custom-set) 'set-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 (value (get symbol 'saved-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 (comment (get symbol 'saved-variable-comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 (cond ((or value comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 (funcall set symbol (eval (car value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 (signal 'error (list "No saved value for variable" symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 (put symbol 'customized-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 (put symbol 'customized-variable-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 ;; This call will possibly make the comment invisible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 (custom-redraw widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2433 ;; This function returns non nil if we need to re-save the options --dv.
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2434 (defun custom-variable-pre-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2435 "Prepare for restoring the variable being edited by WIDGET to its
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2436 standard setting."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 (let* ((symbol (widget-value widget))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2438 (set (or (get symbol 'custom-set) 'set-default)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 (if (get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 (funcall set symbol (eval (car (get symbol 'standard-value))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 (signal 'error (list "No standard setting known for variable" symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 (put symbol 'variable-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 (put symbol 'customized-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 (put symbol 'customized-variable-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 (put symbol 'saved-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 ;; As a special optimizations we do not (explictly)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2449 ;; save resets to standard when no theme sets the value.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 (if (null (cdr (get symbol 'theme-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 (put symbol 'theme-value nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 (put symbol 'saved-variable-comment nil)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2453 widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2454 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2455
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2456 (defun custom-variable-post-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2457 "Finish resetting the variable being edited by WIDGET to its standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2458 value."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2459 (widget-put widget :custom-state 'unknown)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2460 ;; This call will possibly make the comment invisible
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2461 (custom-redraw widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2462
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2463 (defun custom-variable-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2464 "Restore the standard setting for the variable being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2465 (when (custom-variable-pre-reset-standard widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2466 (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2467 (custom-variable-post-reset-standard widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2468
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 ;;; The `custom-face-edit' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 (define-widget 'custom-face-edit 'checklist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 "Edit face attributes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 :format "%t: %v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 :tag "Attributes"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 :extra-offset 12
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
2477 :button-args '(:help-echo "Control whether this attribute has any effect")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 :args (mapcar (lambda (att)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 (list 'group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 :sibling-args (widget-get (nth 1 att) :sibling-args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 (list 'const :format "" :value (nth 0 att))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 (nth 1 att)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 custom-face-attributes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 ;;; The `custom-display' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 (define-widget 'custom-display 'menu-choice
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 "Select a display type."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 :tag "Display"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 :value t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 :help-echo "Specify frames where the face attributes should be used"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 :args '((const :tag "all" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 (checklist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 :extra-offset 9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 :args ((group :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 Only match the specified window systems")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 (const :format "Type: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 (checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 (const :format "X "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 The X11 Window System")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 x)
555
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2507 (const :format "GTK "
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2508 :sibling-args (:help-echo "\
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2509 The GTK Window System")
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2510 gtk)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 (const :format "PM "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 OS/2 Presentation Manager")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 pm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 (const :format "MSWindows "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 :sibling-args (:help-echo "\
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2517 Microsoft Windows, displays")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 mswindows)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2519 (const :format "MSPrinter "
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 :sibling-args (:help-echo "\
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2521 Microsoft Windows, printers")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2522 msprinter)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 (const :format "TTY%n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 Plain text terminals")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 tty)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 (group :sibling-args (:help-echo "\
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2528 Only match display or printer devices")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2529 (const :format "Output: "
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2530 class)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2531 (checklist :inline t
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2532 :offset 0
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2533 (const :format "Display "
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2534 :sibling-args (:help-echo "\
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2535 Match display devices")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2536 display)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2537 (const :format "Printer%n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2538 :sibling-args (:help-echo "\
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2539 Match printer devices")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2540 printer)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2541 (group :sibling-args (:help-echo "\
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 Only match the frames with the specified color support")
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2543 (const :format "Color support: "
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 (checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 (const :format "Color "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 Match color frames")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 (const :format "Grayscale "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 Match grayscale frames")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 grayscale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 (const :format "Monochrome%n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 Match frames with no color support")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 mono)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 (group :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 Only match frames with the specified intensity")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 (const :format "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 Background brightness: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 background)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 (checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 (const :format "Light "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 Match frames with light backgrounds")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 light)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 (const :format "Dark\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 Match frames with dark backgrounds")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 dark)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 ;;; The `custom-face' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 (defface custom-face-tag-face '((t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 "Face used for face tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 (defcustom custom-face-default-form 'selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 "Default form of displaying face definition."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 :type '(choice (const all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 (const selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 (const lisp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 (define-widget 'custom-face 'custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 "Customize face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 :sample-face 'custom-face-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 :help-echo "Set or reset this face"
4021
cef5f57bb9e2 [xemacs-hg @ 2007-06-21 13:39:08 by aidan]
aidan
parents: 2544
diff changeset
2592 :documentation-property #'(lambda (face)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
2593 (face-doc-string face))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 :value-create 'custom-face-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 :action 'custom-face-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 :custom-category 'face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 :custom-form nil ; defaults to value of `custom-face-default-form'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 :custom-set 'custom-face-set
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2599 :custom-pre-save 'custom-face-pre-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 :custom-save 'custom-face-save
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2601 :custom-post-save 'custom-face-post-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 :custom-reset-current 'custom-redraw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 :custom-reset-saved 'custom-face-reset-saved
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2604 :custom-pre-reset-standard 'custom-face-pre-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 :custom-reset-standard 'custom-face-reset-standard
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2606 :custom-post-reset-standard 'custom-face-post-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 :custom-menu 'custom-face-menu-create)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 (define-widget 'custom-face-all 'editable-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 "An editable list of display specifications and attributes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 :entry-format "%i %d %v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 :insert-button-args '(:help-echo "Insert new display specification here")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 :append-button-args '(:help-echo "Append new display specification here")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 :delete-button-args '(:help-echo "Delete this display specification")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 :args '((group :format "%v" custom-display custom-face-edit)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 (defconst custom-face-all (widget-convert 'custom-face-all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 "Converted version of the `custom-face-all' widget.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 (define-widget 'custom-display-unselected 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 "A display specification that doesn't match the selected display."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 :match 'custom-display-unselected-match)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 (defun custom-display-unselected-match (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 "Non-nil if VALUE is an unselected display specification."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 (not (face-spec-set-match-display value (selected-frame))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 (define-widget 'custom-face-selected 'group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 "Edit the attributes of the selected display in a face specification."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 :args '((repeat :format ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 (group custom-display-unselected sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 (group (sexp :format "") custom-face-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 (repeat :format ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 (defconst custom-face-selected (widget-convert 'custom-face-selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 "Converted version of the `custom-face-selected' widget.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 (defun custom-face-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 "Create a list of the display specifications for WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 (let ((buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 children
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 (symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 (tag (widget-get widget :tag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 (begin (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 (is-last (widget-get widget :custom-last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 (prefix (widget-get widget :custom-prefix)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 (unless tag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 (setq tag (prin1-to-string symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 (cond ((eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 (insert prefix (if is-last " `--- " " |--- "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 widget 'custom-browse-face-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 ;; Create tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 (insert tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 (if (eq custom-buffer-style 'face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 (widget-specify-sample widget begin (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 (insert ": "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 ;; Sample.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 (and (not (find-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 ;; XEmacs cannot display uninitialized faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 (make-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 (push (widget-create-child-and-convert widget 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 :format "(%{%t%})"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 :sample-face symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 :tag "sample")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 ;; Visibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 :help-echo "Hide or show this face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 (not (eq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 ;; Magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 widget 'custom-magic nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 ;; Update buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 ;; Insert documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 (widget-default-format-handler widget ?h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 ;; The comment field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 (let* ((comment (get symbol 'face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 (comment-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 widget 'custom-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 :parent widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 :value (or comment ""))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 (widget-put widget :comment-widget comment-widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 (push comment-widget children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 ;; See also.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 (when (eq (widget-get widget :custom-level) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 (custom-add-parent-links widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 (custom-add-see-also widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 ;; Editor.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 (insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 (message "Creating face editor...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 (unless (widget-get widget :custom-form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 (widget-put widget :custom-form custom-face-default-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 (spec (custom-face-get-spec symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 (form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 (indent (widget-get widget :indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 (edit (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 (cond ((and (eq form 'selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 (widget-apply custom-face-selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 :match spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 (when indent (insert-char ?\ indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 'custom-face-selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 ((and (not (eq form 'lisp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 (widget-apply custom-face-all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 :match spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 'custom-face-all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 (when indent (insert-char ?\ indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 'sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 :value spec)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 (custom-face-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 (push edit children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 (widget-put widget :children children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 (message "Creating face editor...done"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 (defvar custom-face-menu
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2742 `(("Set for Current Session" custom-face-set)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 ("Save for Future Sessions" custom-face-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 ("Reset to Saved" custom-face-reset-saved
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2745 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2746 (or (get (widget-value widget) 'saved-face)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2747 (get (widget-value widget) 'saved-face-comment))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 ("Reset to Standard Setting" custom-face-reset-standard
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2749 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2750 (get (widget-value widget) 'face-defface-spec)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 ("Add Comment" custom-comment-show custom-comment-invisible-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 ("Show all display specs" custom-face-edit-all
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2755 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2756 (not (eq (widget-get widget :custom-form) 'all))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 ("Just current attributes" custom-face-edit-selected
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2758 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2759 (not (eq (widget-get widget :custom-form) 'selected))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 ("Show as Lisp expression" custom-face-edit-lisp
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
2761 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
2762 (not (eq (widget-get widget :custom-form) 'lisp)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 "Alist of actions for the `custom-face' widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 the menu entry, ACTION is the function to call on the widget when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 menu is selected, and FILTER is a predicate which takes a `custom-face'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 widget as an argument, and returns non-nil if ACTION is valid on that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 widget. If FILTER is nil, ACTION is always valid.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 (defun custom-face-edit-selected (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 "Edit selected attributes of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 (widget-put widget :custom-form 'selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 (defun custom-face-edit-all (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 "Edit all attributes of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 (widget-put widget :custom-form 'all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 (defun custom-face-edit-lisp (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 "Edit the lisp representation of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 (widget-put widget :custom-form 'lisp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 (defun custom-face-state-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 "Set the state of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 (comment (get symbol 'face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 tmp temp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 (widget-put widget :custom-state
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 (cond ((progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 (setq tmp (get symbol 'customized-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 (setq temp (get symbol 'customized-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 (if (equal temp comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 'set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 ((progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 (setq tmp (get symbol 'saved-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 (setq temp (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 (if (equal temp comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 'saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 ((get symbol 'face-defface-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 (if (equal comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 'standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 'rogue)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 (defun custom-face-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 "Show the menu for `custom-face' WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 Optional EVENT is the location for the menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 (if (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 (custom-toggle-hide widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 (symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 (answer (widget-choose (concat "Operation on "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 (custom-unlispify-tag-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 (custom-menu-filter custom-face-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 (funcall answer widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 (defun custom-face-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 "Make the face attributes in WIDGET take effect."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 (value (widget-value child))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 (comment (widget-value comment-widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 (put symbol 'customized-face value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 (put symbol 'customized-face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 (put symbol 'face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 (custom-face-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 (custom-redraw-magic widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2849 (defun custom-face-pre-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2850 "Prepare for saving the face being edited by WIDGET."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 (value (widget-value child))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 (comment (widget-value comment-widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 (put symbol 'saved-face value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 (custom-push-theme 'theme-face symbol 'user 'set value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 (put symbol 'customized-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 (put symbol 'face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 (put symbol 'customized-face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 (put symbol 'saved-face-comment comment)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2868 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2869
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2870 (defun custom-face-post-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2871 "Finish saving the face being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2872 (custom-face-state-set widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2873 (custom-redraw-magic widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2874
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2875 (defun custom-face-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2876 "Save the face being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2877 (custom-face-pre-save widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2878 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2879 (custom-face-post-save widget))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 (defun custom-face-reset-saved (widget)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2882 "Reset the face being edited by WIDGET to its saved value."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 (value (get symbol 'saved-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 (comment (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 (comment-widget (widget-get widget :comment-widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 (unless (or value comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 (signal 'error (list "No saved value for this face" symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 (put symbol 'customized-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 (put symbol 'customized-face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 (put symbol 'face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 (widget-value-set child value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 ;; This call manages the comment visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 (widget-value-set comment-widget (or comment ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 (custom-face-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 (custom-redraw-magic widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2900 ;; This function returns non nil if we need to re-save the options --dv.
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2901 (defun custom-face-pre-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2902 "Prepare for restoring the face edited by WIDGET to its standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2903 settings."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 (let* ((symbol (widget-value widget))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2905 (value (get symbol 'face-defface-spec)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 (unless value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 (signal 'error (list "No standard setting for this face" symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 (put symbol 'customized-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 (put symbol 'customized-face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 (put symbol 'saved-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 ;; Do not explictly save resets to standards without themes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 (if (null (cdr (get symbol 'theme-face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 (put symbol 'theme-face nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 (put symbol 'saved-face-comment nil)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2917 widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2918 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2919
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2920 (defun custom-face-post-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2921 "Finish restoring the face edited by WIDGET to its standard settings."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2922 (let* ((symbol (widget-value widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2923 (child (car (widget-get widget :children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2924 (value (get symbol 'face-defface-spec))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2925 (comment-widget (widget-get widget :comment-widget)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 (put symbol 'face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 (widget-value-set child value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 ;; This call manages the comment visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 (widget-value-set comment-widget "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 (custom-face-state-set widget)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2932 (custom-redraw-magic widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2933 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2934
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2935 (defun custom-face-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2936 "Restore the face edited by WIDGET to its standard settings."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2937 (when (custom-face-pre-reset-standard widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2938 (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2939 (custom-face-post-reset-standard widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2940
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 ;;; The `face' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 (define-widget 'face 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 "Select and customize a face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 :convert-widget 'widget-value-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 :button-prefix 'widget-push-button-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 :button-suffix 'widget-push-button-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 :format "%t: %[select face%] %v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 :tag "Face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 :value 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 :value-create 'widget-face-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 :value-delete 'widget-face-value-delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 :value-get 'widget-value-value-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 :validate 'widget-children-validate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 :action 'widget-face-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 :match (lambda (widget value) (symbolp value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 (defun widget-face-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 ;; Create a `custom-face' child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 (custom-buffer-style 'face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 (child (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 widget 'custom-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 :custom-level nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 :value symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 (custom-magic-reset child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 (setq custom-options (cons child custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 (widget-put widget :children (list child))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 (defun widget-face-value-delete (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 ;; Remove the child from the options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 (let ((child (car (widget-get widget :children))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 (setq custom-options (delq child custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 (widget-children-value-delete widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 (defvar face-history nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 "History of entered face names.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 (defun widget-face-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 "Prompt for a face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 (let ((answer (completing-read "Face: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 (mapcar (lambda (face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 (list (symbol-name face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 (face-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 nil nil nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 'face-history)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 (unless (zerop (length answer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 (widget-value-set widget (intern answer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 (widget-apply widget :notify widget event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 (widget-setup))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 ;;; The `hook' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 (define-widget 'hook 'list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 "A emacs lisp hook"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 :value-to-internal (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 (if (symbolp value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 (list value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 :match (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 (or (symbolp value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 (widget-group-match widget value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 :convert-widget 'custom-hook-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 :tag "Hook")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 (defun custom-hook-convert-widget (widget)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
3008 ;; Handle `:options'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 (let* ((options (widget-get widget :options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 (other `(editable-list :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 :entry-format "%i %d%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 (function :format " %v")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 (args (if options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 (list `(checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 ,@(mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 `(function-item ,entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 (list other))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 (widget-put widget :args args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 ;;; The `plist' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 (define-widget 'plist 'list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 "A property list."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 :match (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 (valid-plist-p value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 :convert-widget 'custom-plist-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 :tag "Property List")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 ;; #### Should handle options better.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 (defun custom-plist-convert-widget (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 (let* ((options (widget-get widget :options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 (other `(editable-list :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 (group :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 (symbol :format "%t: %v "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 :size 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 :tag "Property")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 (sexp :tag "Value"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 (args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 (if options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 `((checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 ,@(mapcar 'custom-plist-process-option options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 ,other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 (list other))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 (widget-put widget :args args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 (defun custom-plist-process-option (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 `(group :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 (const :tag "Property"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 :format "%t: %v "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 :size 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 ,entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 (sexp :tag "Value")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 ;;; The `custom-group-link' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 (define-widget 'custom-group-link 'link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 :help-echo 'custom-group-link-help-echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 :action 'custom-group-link-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 (defun custom-group-link-help-echo (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 (concat "Create customization buffer for the `"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 (custom-unlispify-tag-name (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 "' group"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 (defun custom-group-link-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 (customize-group (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 ;;; The `custom-group' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 (defcustom custom-group-tag-faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 ;; In XEmacs, this ought to play games with font size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 "Face used for group tags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 The first member is used for level 1 groups, the second for level 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 and so forth. The remaining group tags are shown with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 `custom-group-tag-face'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 :type '(repeat face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 (defface custom-group-tag-face-1 '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 (:foreground "pink" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 (:foreground "red" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 (t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 "Face used for group tags.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 (defface custom-group-tag-face '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 (:foreground "light blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 (:foreground "blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 (t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 "Face used for low level group tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 (define-widget 'custom-group 'custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 "Customize group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 :sample-face-get 'custom-group-sample-face-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 :documentation-property 'group-documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 :help-echo "Set or reset all members of this group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 :value-create 'custom-group-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 :action 'custom-group-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 :custom-category 'group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 :custom-set 'custom-group-set
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3113 :custom-pre-save 'custom-group-pre-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 :custom-save 'custom-group-save
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3115 :custom-post-save 'custom-group-post-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 :custom-reset-current 'custom-group-reset-current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 :custom-reset-saved 'custom-group-reset-saved
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3118 :custom-pre-reset-standard 'custom-group-pre-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 :custom-reset-standard 'custom-group-reset-standard
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3120 :custom-post-reset-standard 'custom-group-post-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 :custom-menu 'custom-group-menu-create)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 (defun custom-group-sample-face-get (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 ;; Use :sample-face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 'custom-group-tag-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 (define-widget 'custom-group-visibility 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 "An indicator and manipulator for hidden group contents."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 :create 'custom-group-visibility-create)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 (defun custom-group-visibility-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 (let ((visible (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 (if visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 (insert "--------")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 (widget-default-create widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 (defun custom-group-members (symbol groups-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 "Return SYMBOL's custom group members.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 If GROUPS-ONLY non-nil, return only those members that are groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 (if (not groups-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 (get symbol 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 (let (members)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 (dolist (entry (get symbol 'custom-group) (nreverse members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 (when (eq (nth 1 entry) 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 (push entry members))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 (defun custom-group-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 "Insert a customize group for WIDGET in the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 (let* ((state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 (level (widget-get widget :custom-level))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 ;; (indent (widget-get widget :indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 (prefix (widget-get widget :custom-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 (buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 (tag (widget-get widget :tag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 (symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 (members (custom-group-members symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 (and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 custom-browse-only-groups))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 (cond ((and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 (or members (custom-unloaded-widget-p widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 widget 'custom-browse-visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 ;; :tag-glyph "plus"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 :tag "+")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 (insert "-- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 ;; (widget-glyph-insert nil "-- " "horizontal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 ((and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 (zerop (length members)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 (insert "[ ]-- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 ;; (widget-glyph-insert nil "[ ]" "empty")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 ;; (widget-glyph-insert nil "-- " "horizontal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 ((eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 (if (zerop (length members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 (insert "[ ]-- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 ;; (widget-glyph-insert nil "[ ]" "empty")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 ;; (widget-glyph-insert nil "-- " "horizontal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 widget 'custom-browse-visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 ;; :tag-glyph "minus"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 :tag "-")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 (insert "-\\ ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 ;; (widget-glyph-insert nil "-\\ " "top")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 (message "Creating group...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 (let* ((members (custom-sort-items members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 custom-browse-sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 custom-browse-order-groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 (prefixes (widget-get widget :custom-prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 (custom-prefix-list (custom-prefix-add symbol prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 (extra-prefix (if (widget-get widget :custom-last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 " "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 " | "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 (prefix (concat prefix extra-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 children entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 (while members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 (setq entry (car members)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 members (cdr members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 widget (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 :group widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 :tag (custom-unlispify-tag-name (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 :custom-prefixes custom-prefix-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 :custom-level (1+ level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 :custom-last (null members)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 :value (nth 0 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 :custom-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 (widget-put widget :children (reverse children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 (message "Creating group...done")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 ;; Nested style.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 ;; Create level indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 (unless (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 (insert-char ?\ (* custom-buffer-indent (1- level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 (insert "-- "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 ;; Create link indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 (when (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 widget 'custom-group-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 :tag "Open"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 :tag-glyph '("open-up" "open-down")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 (insert " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 ;; Create tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 (let ((begin (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 (insert tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 (widget-specify-sample widget begin (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 (insert " group")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 ;; Create visibility indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 (unless (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 (insert ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 widget 'custom-group-visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 :help-echo "Show members of this group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 (not (eq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 (insert " \n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 ;; Create magic button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 widget 'custom-magic nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 ;; Update buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 ;; Insert documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 (if (and (eq custom-buffer-style 'links) (> level 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 (widget-put widget :documentation-indent 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 (widget-default-format-handler widget ?h))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 ;; Nested style.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 (t ;Visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 ;; Update members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 (setq members (custom-group-members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 symbol (and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 custom-browse-only-groups)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 ;; Add parent groups references above the group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 (if t ;;; This should test that the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 ;;; was made to display a group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 (when (eq level 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 (if (custom-add-parent-links widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 "Go to parent group:")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 (insert "\n"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 ;; Create level indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 (insert-char ?\ (* custom-buffer-indent (1- level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 (insert "/- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 ;; Create tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 (let ((start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 (insert tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 (widget-specify-sample widget start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 (insert " group: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 ;; Create visibility indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 (unless (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 (insert "--------")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 :help-echo "Hide members of this group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 (not (eq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 (insert " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 ;; Create more dashes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 ;; Use 76 instead of 75 to compensate for the temporary "<"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 ;; added by `widget-insert'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 (insert-char ?- (- 76 (current-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317 (* custom-buffer-indent level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 (insert "\\\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 ;; Create magic button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 widget 'custom-magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 :indent 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 ;; Update buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 ;; Insert documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 (widget-default-format-handler widget ?h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 ;; Parent groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 (if nil ;;; This should test that the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 ;;; was not made to display a group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333 (when (eq level 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 (insert-char ?\ custom-buffer-indent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 (custom-add-parent-links widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 (custom-add-see-also widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 (make-string (* custom-buffer-indent level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 ?\ ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 ;; Members.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 (message "Creating group...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 (let* ((members (custom-sort-items members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 custom-buffer-sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 custom-buffer-order-groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 (prefixes (widget-get widget :custom-prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 (custom-prefix-list (custom-prefix-add symbol prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 (length (length members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 (count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 (children (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 (widget-insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 (when (zerop (% count custom-skip-messages))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 'progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 (format "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 Creating group members... %2d%%"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 (/ (* 100.0 count) length))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 (incf count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 widget (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 :group widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 :tag (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 :custom-prefixes custom-prefix-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 :custom-level (1+ level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 :value (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 (widget-insert "\n"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 members)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 (message "Creating group magic...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 (mapc 'custom-magic-reset children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 (message "Creating group state...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 (widget-put widget :children children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 (custom-group-state-update widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 (message "Creating group... done"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 ;; End line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 (insert-char ?\ (* custom-buffer-indent (1- level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 (insert "\\- " (widget-get widget :tag) " group end ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 (insert "/\n")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 (defvar custom-group-menu
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
3384 `(("Set for Current Session" custom-group-set
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
3385 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3386 (eq (widget-get widget :custom-state) 'modified)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 ("Save for Future Sessions" custom-group-save
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
3388 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3389 (memq (widget-get widget :custom-state) '(modified set))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 ("Reset to Current" custom-group-reset-current
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
3391 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3392 (memq (widget-get widget :custom-state) '(modified))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 ("Reset to Saved" custom-group-reset-saved
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
3394 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3395 (memq (widget-get widget :custom-state) '(modified set))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 ("Reset to standard setting" custom-group-reset-standard
4289
20accccbebd6 [xemacs-hg @ 2007-11-27 22:15:32 by aidan]
aidan
parents: 4257
diff changeset
3397 ,#'(lambda (widget)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3398 (memq (widget-get widget :custom-state) '(modified set saved)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 "Alist of actions for the `custom-group' widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 the menu entry, ACTION is the function to call on the widget when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 menu is selected, and FILTER is a predicate which takes a `custom-group'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 widget as an argument, and returns non-nil if ACTION is valid on that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 widget. If FILTER is nil, ACTION is always valid.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 (defun custom-group-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 "Show the menu for `custom-group' WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 Optional EVENT is the location for the menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 (if (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 (custom-toggle-hide widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 (answer (widget-choose (concat "Operation on "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 (widget-get widget :value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 (custom-menu-filter custom-group-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 (funcall answer widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 (defun custom-group-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 "Set changes in all modified group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 (widget-apply child :custom-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3429 (defun custom-group-pre-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3430 "Prepare for saving all modified group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3431 (let ((children (widget-get widget :children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3432 (mapc (lambda (child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3433 (when (memq (widget-get child :custom-state) '(modified set))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3434 (widget-apply child :custom-pre-save)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3435 children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3436
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3437 (defun custom-group-post-save (widget)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 "Save all modified group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 (when (memq (widget-get child :custom-state) '(modified set))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3442 (widget-apply child :custom-post-save)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3445 (defun custom-group-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3446 "Save all modified group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3447 (custom-group-pre-save widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3448 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3449 (custom-group-post-save widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3450
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 (defun custom-group-reset-current (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 "Reset all modified group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 (widget-apply child :custom-reset-current)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 (defun custom-group-reset-saved (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 "Reset all modified or set group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 (when (memq (widget-get child :custom-state) '(modified set))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 (widget-apply child :custom-reset-saved)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3467 ;; This function returns non nil when we need to re-save the options --dv.
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3468 (defun custom-group-pre-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3469 "Prepare for resetting all modified, set, or saved group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3470 (let ((children (widget-get widget :children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3471 must-save)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3472 (mapc (lambda (child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3473 (when (memq (widget-get child :custom-state)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3474 '(modified set saved))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3475 (and (widget-apply child :custom-pre-reset-standard)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3476 (setq must-save t))))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3477 children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3478 must-save
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3479 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3481 (defun custom-group-post-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3482 "Finish resetting all modified, set, or saved group members."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 (when (memq (widget-get child :custom-state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 '(modified set saved))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3487 (widget-apply child :custom-post-reset-standard)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3490 (defun custom-group-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3491 "Reset all modified, set, or saved group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3492 (when (custom-group-pre-reset-standard widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3493 (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3494 (custom-group-post-reset-standard widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3495
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 (defun custom-group-state-update (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 "Update magic."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 (unless (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 (let* ((children (widget-get widget :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 (states (mapcar (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 (widget-get child :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 (magics custom-magic-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 (found 'standard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 (while magics
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 (let ((magic (car (car magics))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 (if (and (not (eq magic 'hidden))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 (memq magic states))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 (setq found magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 magics nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 (setq magics (cdr magics)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 (widget-put widget :custom-state found)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 (custom-magic-reset widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 (defun custom-save-delete (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 "Delete the call to SYMBOL form in `custom-file'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 Leave point at the location of the call, or after the last expression."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 (let ((find-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 (auto-mode-alist nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 (set-buffer (find-file-noselect custom-file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 (catch 'found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 (while t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 (let ((sexp (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 (read (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 (end-of-file (throw 'found nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 (when (and (listp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 (eq (car sexp) symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 (delete-region (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 (backward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 (throw 'found nil))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3535 (defun custom-save-delete-any (&rest symbols)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3536 "Delete the call to any symbol among SYMBOLS in `custom-file'.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3537 Leave the point at the end of the file."
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3538 (let ((find-file-hooks nil)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3539 (auto-mode-alist nil))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3540 (set-buffer (find-file-noselect custom-file)))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3541 (goto-char (point-min))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3542 (condition-case nil
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3543 (while (not (eobp))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3544 (let ((sexp (read (current-buffer))))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3545 (when (and (listp sexp)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3546 (memq (car sexp) symbols))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3547 (delete-region (save-excursion
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3548 (backward-sexp)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3549 (point))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3550 (point))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3551 (while (and (eolp) (not (eobp)))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3552 (delete-region (point) (prog2 (forward-line 1) (point))))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3553 )))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3554 (end-of-file nil)))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3555
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3556 (defsubst custom-save-variable-p (symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3557 "Return non-nil if symbol SYMBOL is a customized variable."
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3558 (and (symbolp symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3559 (let ((spec (car-safe (get symbol 'theme-value))))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3560 (or (and spec (eq (car spec) 'user)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3561 (eq (second spec) 'set))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3562 (get symbol 'saved-variable-comment)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3563 ;; support non-themed vars
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3564 (and (null spec) (get symbol 'saved-value))))))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3565
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3566 (defun custom-save-variable-internal (symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3567 "Print variable SYMBOL to the standard output.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3568 SYMBOL must be a customized variable."
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3569 (let ((requests (get symbol 'custom-requests))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3570 (now (not (or (get symbol 'standard-value)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3571 (and (not (boundp symbol))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3572 (not (eq (get symbol 'force-value)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3573 'rogue))))))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3574 (comment (get symbol 'saved-variable-comment))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3575 ;; Print everything, no placeholders `...'
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3576 (print-level nil)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3577 (print-length nil))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3578 (unless (custom-save-variable-p symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3579 (error 'wrong-type-argument "Not a customized variable" symbol))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3580 (princ "\n '(")
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3581 (prin1 symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3582 (princ " ")
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3583 ;; This comment stuff is in the way ####
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3584 ;; Is (eq (third spec) (car saved-value)) ????
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3585 ;; (prin1 (third spec))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3586 ;; XEmacs -- pretty-print value if available
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3587 (if (and custom-save-pretty-print
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3588 (fboundp 'pp))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3589 ;; To suppress bytecompiler warning
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3590 (with-fboundp 'pp
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3591 (pp (car (get symbol 'saved-value))))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3592 (prin1 (car (get symbol 'saved-value))))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3593 (when (or now requests comment)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3594 (princ (if now " t" " nil")))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3595 (when (or comment requests)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3596 (princ " ")
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3597 (prin1 requests))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3598 (when comment
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3599 (princ " ")
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3600 (prin1 comment))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3601 (princ ")")))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3602
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 (defun custom-save-variables ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 "Save all customized variables in `custom-file'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 (custom-save-delete 'custom-load-themes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 (custom-save-delete 'custom-reset-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 (custom-save-delete 'custom-set-variables)
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3609 ;; This leaves point at the end of file.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3610 ;; Adrian Aichner <adrian@xemacs.org> stated it is
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3611 ;; a bad behavior <npak@ispras.ru>
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3612 ;;(custom-save-delete-any 'custom-load-themes
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3613 ;; 'custom-reset-variables
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3614 ;; 'custom-set-variables)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 (custom-save-loaded-themes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 (custom-save-resets 'theme-value 'custom-reset-variables nil)
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3617 (let ((standard-output (current-buffer))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3618 (sorted-list ()))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3619 ;; First create a sorted list of saved variables.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3620 (mapatoms
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3621 (lambda (symbol)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3622 (when (custom-save-variable-p symbol)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3623 (push symbol sorted-list))))
2122
3c70cbcc7ae8 [xemacs-hg @ 2004-06-10 12:20:00 by adrian]
adrian
parents: 2118
diff changeset
3624 (setq sorted-list (sort sorted-list 'string<))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 (unless (bolp)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3626 (princ "\n"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 (princ "(custom-set-variables")
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3628 (mapc 'custom-save-variable-internal
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3629 sorted-list)
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3630 (princ ")")
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3631 (unless (looking-at "\n")
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3632 (princ "\n")))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 (defvar custom-save-face-ignoring nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3636 (defsubst custom-save-face-p (symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3637 "Return non-nil if SYMBOL is a customized face."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 (let ((theme-spec (car-safe (get symbol 'theme-face)))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3639 (comment (get symbol 'saved-face-comment)))
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3640 (or (and (not (memq symbol custom-save-face-ignoring))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3641 ;; Don't print default face here.
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3642 (or (and theme-spec
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3643 (eq (car theme-spec) 'user)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3644 (eq (second theme-spec) 'set))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3645 ;; cope with non-themed faces
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3646 (and (null theme-spec)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3647 (get symbol 'saved-face))))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3648 comment)))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3649
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3650 (defun custom-save-face-internal (symbol)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3651 "Print face SYMBOL to the standard output.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3652 SYMBOL must be a customized face."
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3653 (let ((comment (get symbol 'saved-face-comment))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 (now (not (or (get symbol 'face-defface-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 (and (not (find-face symbol))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3656 (not (eq (get symbol 'force-face) 'rogue))))))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3657 ;; Print everything, no placeholders `...'
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3658 (print-level nil)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3659 (print-length nil))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3660 (if (memq symbol custom-save-face-ignoring)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3661 ;; Do nothing
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3662 nil
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3663 ;; Print face
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3664 (unless (custom-save-face-p symbol)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3665 (error 'wrong-type-argument "Not a customized face" symbol))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 (princ "\n '(")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 (prin1 symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 (princ " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 (prin1 (get symbol 'saved-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 (if (or comment now)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3671 (princ (if now " t" " nil")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 (when comment
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3673 (princ " ")
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3674 (prin1 comment))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 (princ ")"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 (defun custom-save-faces ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 "Save all customized faces in `custom-file'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 (custom-save-delete 'custom-reset-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 (custom-save-delete 'custom-set-faces)
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3682 ;; This leaves point at the end of file.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3683 ;; Adrian Aichner <adrian@xemacs.org> stated it is
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3684 ;; a bad behavior <npak@ispras.ru>
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3685 ;;(custom-save-delete-any 'custom-reset-faces
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3686 ;; 'custom-set-faces)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 (custom-save-resets 'theme-face 'custom-reset-faces '(default))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3688 (let ((standard-output (current-buffer))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3689 (sorted-list ()))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3690 ;; Create a sorted list of faces
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3691 (mapatoms
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3692 (lambda (symbol)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3693 (when (custom-save-face-p symbol)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3694 (push symbol sorted-list))))
2122
3c70cbcc7ae8 [xemacs-hg @ 2004-06-10 12:20:00 by adrian]
adrian
parents: 2118
diff changeset
3695 (setq sorted-list (sort sorted-list 'string<))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 (unless (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 (princ "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 (princ "(custom-set-faces")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 ;; The default face must be first, since it affects the others.
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3700 (when (custom-save-face-p 'default)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3701 (custom-save-face-internal 'default))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 (let ((custom-save-face-ignoring '(default)))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3703 (mapc 'custom-save-face-internal
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3704 sorted-list))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 (princ ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 (unless (looking-at "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 (princ "\n")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3709 (defmacro make-custom-save-resets-mapper (property setter)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3710 "Create a mapper for `custom-save-resets'."
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3711 `(lambda (object)
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3712 (let ((spec (car-safe (get object (quote ,property))))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3713 (print-level nil)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3714 (print-length nil))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3715 (with-boundp '(ignored-special started-writing)
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3716 (when (and (not (memq object ignored-special))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3717 (eq (car spec) 'user)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3718 (eq (second spec) 'reset))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3719 ;; Do not write reset statements unless necessary.
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3720 (unless started-writing
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3721 (setq started-writing t)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3722 (unless (bolp)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3723 (princ "\n"))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3724 (princ "(")
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3725 (princ (quote ,setter))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3726 (princ "\n '(")
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3727 (prin1 object)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3728 (princ " ")
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3729 (prin1 (third spec))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3730 (princ ")")))))))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3731
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3732 (defconst custom-save-resets-mapper-alist
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3733 (eval-when-compile
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3734 (list (list 'theme-value 'custom-reset-variables
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3735 (byte-compile
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3736 (make-custom-save-resets-mapper
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3737 'theme-value 'custom-reset-variables)))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3738 (list 'theme-face 'custom-reset-faces
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3739 (byte-compile
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3740 (make-custom-save-resets-mapper
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3741 'theme-face 'custom-reset-faces)))))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3742 "Never use it.
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3743 Hashes several heavily used functions for `custom-save-resets'")
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3744
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 (defun custom-save-resets (property setter special)
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3746 (declare (special ignored-special))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 (let (started-writing ignored-special)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3748 ;; (custom-save-delete setter) Done by caller
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 (let ((standard-output (current-buffer))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3750 (mapper (let ((triple (assq property custom-save-resets-mapper-alist)))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3751 (if (and triple (eq (second triple) setter))
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3752 (third triple)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3753 (make-custom-save-resets-mapper property setter)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 (mapc mapper special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 (setq ignored-special special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 (mapatoms mapper)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 (when started-writing
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3758 (princ ")\n")))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3759
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 (defun custom-save-loaded-themes ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 (let ((themes (reverse (get 'user 'theme-loads-themes)))
848
0cb55b2a2c66 [xemacs-hg @ 2002-05-17 18:28:45 by adrian]
adrian
parents: 782
diff changeset
3763 (standard-output (current-buffer))
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3764 (print-level nil)
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3765 (print-length nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 (when themes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 (unless (bolp) (princ "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 (princ "(custom-load-themes")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 (mapc (lambda (theme)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 (princ "\n '")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 (prin1 theme)) themes)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3772 (princ " )\n"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 (defun customize-save-customized ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 "Save all user options which have been set in this session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 (let ((face (get symbol 'customized-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 (value (get symbol 'customized-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 (face-comment (get symbol 'customized-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 (variable-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 (get symbol 'customized-variable-comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 (when face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 (put symbol 'saved-face face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 (custom-push-theme 'theme-face symbol 'user 'set value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 (put symbol 'customized-face nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 (when value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 (put symbol 'saved-value value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 (custom-push-theme 'theme-value symbol 'user 'set value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 (put symbol 'customized-value nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 (when variable-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 (put symbol 'saved-variable-comment variable-comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 (put symbol 'customized-variable-comment nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 (when face-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 (put symbol 'saved-face-comment face-comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 (put symbol 'customized-face-comment nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 ;; We really should update all custom buffers here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 (custom-save-all))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 (defun custom-save-all ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 "Save all customizations in `custom-file'."
4257
ef6c55ab3090 [xemacs-hg @ 2007-11-08 14:43:38 by aidan]
aidan
parents: 4178
diff changeset
3804 (when init-file-had-error
ef6c55ab3090 [xemacs-hg @ 2007-11-08 14:43:38 by aidan]
aidan
parents: 4178
diff changeset
3805 (error 'invalid-change
ef6c55ab3090 [xemacs-hg @ 2007-11-08 14:43:38 by aidan]
aidan
parents: 4178
diff changeset
3806 "Cannot save customizations; init file was not fully loaded"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 (let ((inhibit-read-only t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 (custom-save-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 (custom-save-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 (let ((find-file-hooks nil)
4382
12ff8dc2b57e Create the containing directory for the custom and init files if necessary.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4289
diff changeset
3811 (auto-mode-alist)
4434
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3812 custom-file-directory)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3813 (unless (file-directory-p (setq custom-file-directory
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3814 (file-name-directory custom-file)))
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3815 (message "Creating %s... " custom-file-directory)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3816 (make-directory custom-file-directory t)
7f3d065a56a1 Ease customization of faces under point...
Didier Verna <didier@xemacs.org>
parents: 4382
diff changeset
3817 (message "Creating %s... done." custom-file-directory))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 (with-current-buffer (find-file-noselect custom-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 (save-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 ;;; The Customize Menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 ;;; Menu support
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 (defun custom-face-menu-create (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 (vector (custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 `(customize-face ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 (defun custom-variable-menu-create (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 "Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 (let ((type (get symbol 'custom-type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 (unless (listp type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 (setq type (list type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 (if (and type (widget-get type :custom-menu))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 (widget-apply type :custom-menu symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 (vector (custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 `(customize-variable ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 ;; Add checkboxes to boolean variable entries.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 (widget-put (get 'boolean 'widget-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 :custom-menu (lambda (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 `[,(custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 (customize-variable ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 :style toggle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 :selected ,symbol]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 ;; XEmacs can create menus dynamically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 (defun custom-group-menu-create (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 `( ,(custom-unlispify-menu-entry symbol t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 :filter (lambda (&rest junk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 (let ((item (custom-menu-create ',symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 (if (listp item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 (cdr item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 (list item))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 (defun custom-menu-create (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 "Create menu for customization group SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 The menu is in a format applicable to `easy-menu-define'."
2544
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3865 (menu-split-long-menu
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3866 (let* ((item (vector (custom-unlispify-menu-entry symbol)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3867 `(customize-group ',symbol)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3868 t)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3869 ;; Item is the entry for creating a menu buffer for SYMBOL.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3870 ;; We may nest, if the menu is not too big.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3871 (custom-load-custom-defines symbol)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3872 (if t ;(< (length (get symbol 'custom-group)) widget-menu-max-size)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3873 ;; The menu is not too big.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3874 (let ((custom-prefix-list (custom-prefix-add symbol
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3875 custom-prefix-list))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3876 (members (custom-sort-items (get symbol 'custom-group)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3877 custom-menu-sort-alphabetically
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3878 custom-menu-order-groups)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3879 ;; Create the menu.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3880 `(,(custom-unlispify-menu-entry symbol t)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3881 ,item
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3882 "--"
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3883 ,@(mapcar (lambda (entry)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3884 (widget-apply (if (listp (nth 1 entry))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3885 (nth 1 entry)
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3886 (list (nth 1 entry)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3887 :custom-menu (nth 0 entry)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3888 members)))
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3889 ; else ;; The menu was too big.
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3890 item
b4a8cd0dd8df [xemacs-hg @ 2005-02-03 04:29:32 by ben]
ben
parents: 2122
diff changeset
3891 ))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 (defun customize-menu-create (symbol &optional name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 "Return a customize menu for customization group SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 If optional NAME is given, use that as the name of the menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 Otherwise the menu will be named `Customize'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 The format is suitable for use with `easy-menu-define'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899 (unless name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 (setq name "Customize"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 `(,name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902 :filter (lambda (&rest junk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 (cdr (custom-menu-create ',symbol)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 ;;; The Custom Mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907 (defvar custom-mode-map nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 "Keymap for `custom-mode'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 (unless custom-mode-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 (setq custom-mode-map (make-sparse-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 (set-keymap-parents custom-mode-map widget-keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 (suppress-keymap custom-mode-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 (define-key custom-mode-map " " 'scroll-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 (define-key custom-mode-map [delete] 'scroll-down)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 (define-key custom-mode-map "q" 'Custom-buffer-done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 (define-key custom-mode-map "u" 'Custom-goto-parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 (define-key custom-mode-map "n" 'widget-forward)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 (define-key custom-mode-map "p" 'widget-backward))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 (easy-menu-define Custom-mode-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 custom-mode-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 "Menu used in customization buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 `("Custom"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 ,(customize-menu-create 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 ["Set" Custom-set t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 ["Save" Custom-save t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 ["Reset to Current" Custom-reset-current t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 ["Reset to Saved" Custom-reset-saved t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 ["Reset to Standard Settings" Custom-reset-standard t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 ["Info" (Info-goto-node "(xemacs)Easy Customization") t]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 (defun Custom-goto-parent ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 "Go to the parent group listed at the top of this buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 If several parents are listed, go to the first of them."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 (if (search-forward "\nGo to parent group: " nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 (let* ((button (get-char-property (point) 'button))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 (parent (downcase (widget-get button :tag))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 (customize-group parent)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 (defcustom custom-mode-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 "Hook called when entering custom-mode."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947 :group 'custom-buffer )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 (defun custom-state-buffer-message (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950 (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 (message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 "To install your edits, invoke [State] and choose the Set operation")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 (defun custom-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955 "Major mode for editing customization buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 The following commands are available:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 Move to next button or editable field. \\[widget-forward]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 Move to previous button or editable field. \\[widget-backward]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 \\<widget-field-keymap>\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 Complete content of editable text field. \\[widget-complete]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 \\<custom-mode-map>\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 Invoke button under point. \\[widget-button-press]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 Set all modifications. \\[Custom-set]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 Make all modifications default. \\[Custom-save]
4178
e687f1912d5b [xemacs-hg @ 2007-09-20 21:18:33 by didierv]
didierv
parents: 4021
diff changeset
3967 Reset all modified options. \\[Custom-reset-current]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 Reset all modified or set options. \\[Custom-reset-saved]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 Reset all options. \\[Custom-reset-standard]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 Entry to this mode calls the value of `custom-mode-hook'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 if that value is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 (kill-all-local-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 (setq major-mode 'custom-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 mode-name "Custom")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 (use-local-map custom-mode-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 (easy-menu-add Custom-mode-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 (make-local-variable 'custom-options)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 (make-local-variable 'widget-documentation-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 (setq widget-documentation-face 'custom-documentation-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 (make-local-variable 'widget-button-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 (setq widget-button-face 'custom-button-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 (make-local-hook 'widget-edit-functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 (run-hooks 'custom-mode-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3988 ;;;###autoload
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3989 (defun custom-migrate-custom-file (new-custom-file-name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3990 "Migrate custom file from home directory."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3991 (mapc 'custom-save-delete
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3992 '(custom-load-themes custom-reset-variables
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3993 custom-set-variables
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3994 custom-set-faces
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3995 custom-reset-faces))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3996 (with-current-buffer (find-file-noselect custom-file)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3997 (save-buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3998 (setq custom-file new-custom-file-name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3999 (custom-save-all))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4000
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 ;;; The End.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003 (provide 'cus-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 ;; cus-edit.el ends here