annotate lisp/cus-edit.el @ 5384:3889ef128488

Fix misspelled words, and some grammar, across the entire source tree. See xemacs-patches message with ID <AANLkTi=edkEKtK3pZ60ytsG5pTJQy2TjAEVCZCLOa-oA@mail.gmail.com>.
author Jerry James <james@xemacs.org>
date Thu, 24 Mar 2011 11:00:11 -0600
parents f00192e1cd49
children 4dee0387b9de
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)))
5366
f00192e1cd49 Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents: 4806
diff changeset
873 (if (eql (length choice) 0)
4434
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)))
5366
f00192e1cd49 Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents: 4806
diff changeset
887 (if (eql (length choice) 0)
4434
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
5366
f00192e1cd49 Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents: 4806
diff changeset
1187 (if (eql (length options) 1)
428
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)
5384
3889ef128488 Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents: 5366
diff changeset
2448 ;; As a special optimization we do not (explicitly)
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)
5384
3889ef128488 Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents: 5366
diff changeset
2913 ;; Do not explicitly save resets to standards without themes.
428
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)))
5366
f00192e1cd49 Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents: 4806
diff changeset
2988 (unless (eql (length answer) 0)
428
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)
5366
f00192e1cd49 Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents: 4806
diff changeset
3177 (eql (length members) 0))
428
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)
5366
f00192e1cd49 Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents: 4806
diff changeset
3190 (if (eql (length members) 0)
428
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