|
28
|
1 ;;; cus-edit.el --- Tools for customization Emacs.
|
|
|
2 ;;
|
|
|
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
|
|
|
4 ;;
|
|
|
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
|
|
|
6 ;; Keywords: help, faces
|
|
149
|
7 ;; Version: 1.97
|
|
28
|
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
|
|
9
|
|
149
|
10 ;; This file is part of GNU Emacs.
|
|
|
11
|
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;; GNU General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
|
26
|
|
28
|
27 ;;; Commentary:
|
|
|
28 ;;
|
|
149
|
29 ;; This file implements the code to create and edit customize buffers.
|
|
|
30 ;;
|
|
28
|
31 ;; See `custom.el'.
|
|
|
32
|
|
|
33 ;;; Code:
|
|
|
34
|
|
|
35 (require 'cus-face)
|
|
|
36 (require 'wid-edit)
|
|
|
37 (require 'easymenu)
|
|
149
|
38 (eval-when-compile (require 'cl))
|
|
|
39
|
|
|
40 (condition-case nil
|
|
|
41 (require 'cus-load)
|
|
|
42 (error nil))
|
|
28
|
43
|
|
|
44 (define-widget-keywords :custom-prefixes :custom-menu :custom-show
|
|
|
45 :custom-magic :custom-state :custom-level :custom-form
|
|
|
46 :custom-set :custom-save :custom-reset-current :custom-reset-saved
|
|
|
47 :custom-reset-factory)
|
|
|
48
|
|
120
|
49 (put 'custom-define-hook 'custom-type 'hook)
|
|
|
50 (put 'custom-define-hook 'factory-value '(nil))
|
|
|
51 (custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
|
|
|
52
|
|
28
|
53 ;;; Customization Groups.
|
|
|
54
|
|
|
55 (defgroup emacs nil
|
|
|
56 "Customization of the One True Editor."
|
|
|
57 :link '(custom-manual "(emacs)Top"))
|
|
|
58
|
|
|
59 ;; Most of these groups are stolen from `finder.el',
|
|
|
60 (defgroup editing nil
|
|
|
61 "Basic text editing facilities."
|
|
|
62 :group 'emacs)
|
|
|
63
|
|
|
64 (defgroup abbrev nil
|
|
|
65 "Abbreviation handling, typing shortcuts, macros."
|
|
|
66 :tag "Abbreviations"
|
|
|
67 :group 'editing)
|
|
|
68
|
|
|
69 (defgroup matching nil
|
|
|
70 "Various sorts of searching and matching."
|
|
|
71 :group 'editing)
|
|
|
72
|
|
|
73 (defgroup emulations nil
|
|
|
74 "Emulations of other editors."
|
|
|
75 :group 'editing)
|
|
|
76
|
|
|
77 (defgroup mouse nil
|
|
|
78 "Mouse support."
|
|
|
79 :group 'editing)
|
|
|
80
|
|
|
81 (defgroup outlines nil
|
|
|
82 "Support for hierarchical outlining."
|
|
|
83 :group 'editing)
|
|
|
84
|
|
|
85 (defgroup external nil
|
|
|
86 "Interfacing to external utilities."
|
|
|
87 :group 'emacs)
|
|
|
88
|
|
|
89 (defgroup bib nil
|
|
|
90 "Code related to the `bib' bibliography processor."
|
|
|
91 :tag "Bibliography"
|
|
|
92 :group 'external)
|
|
|
93
|
|
|
94 (defgroup processes nil
|
|
|
95 "Process, subshell, compilation, and job control support."
|
|
|
96 :group 'external
|
|
|
97 :group 'development)
|
|
|
98
|
|
|
99 (defgroup programming nil
|
|
|
100 "Support for programming in other languages."
|
|
|
101 :group 'emacs)
|
|
|
102
|
|
|
103 (defgroup languages nil
|
|
|
104 "Specialized modes for editing programming languages."
|
|
|
105 :group 'programming)
|
|
|
106
|
|
|
107 (defgroup lisp nil
|
|
|
108 "Lisp support, including Emacs Lisp."
|
|
|
109 :group 'languages
|
|
|
110 :group 'development)
|
|
|
111
|
|
|
112 (defgroup c nil
|
|
|
113 "Support for the C language and related languages."
|
|
|
114 :group 'languages)
|
|
|
115
|
|
|
116 (defgroup tools nil
|
|
|
117 "Programming tools."
|
|
|
118 :group 'programming)
|
|
|
119
|
|
|
120 (defgroup oop nil
|
|
|
121 "Support for object-oriented programming."
|
|
|
122 :group 'programming)
|
|
|
123
|
|
|
124 (defgroup applications nil
|
|
|
125 "Applications written in Emacs."
|
|
|
126 :group 'emacs)
|
|
|
127
|
|
|
128 (defgroup calendar nil
|
|
|
129 "Calendar and time management support."
|
|
|
130 :group 'applications)
|
|
|
131
|
|
|
132 (defgroup mail nil
|
|
|
133 "Modes for electronic-mail handling."
|
|
|
134 :group 'applications)
|
|
|
135
|
|
|
136 (defgroup news nil
|
|
|
137 "Support for netnews reading and posting."
|
|
|
138 :group 'applications)
|
|
|
139
|
|
|
140 (defgroup games nil
|
|
|
141 "Games, jokes and amusements."
|
|
|
142 :group 'applications)
|
|
|
143
|
|
|
144 (defgroup development nil
|
|
|
145 "Support for further development of Emacs."
|
|
|
146 :group 'emacs)
|
|
|
147
|
|
|
148 (defgroup docs nil
|
|
|
149 "Support for Emacs documentation."
|
|
|
150 :group 'development)
|
|
|
151
|
|
|
152 (defgroup extensions nil
|
|
|
153 "Emacs Lisp language extensions."
|
|
|
154 :group 'development)
|
|
|
155
|
|
|
156 (defgroup internal nil
|
|
|
157 "Code for Emacs internals, build process, defaults."
|
|
|
158 :group 'development)
|
|
|
159
|
|
|
160 (defgroup maint nil
|
|
|
161 "Maintenance aids for the Emacs development group."
|
|
|
162 :tag "Maintenance"
|
|
|
163 :group 'development)
|
|
|
164
|
|
|
165 (defgroup environment nil
|
|
|
166 "Fitting Emacs with its environment."
|
|
|
167 :group 'emacs)
|
|
|
168
|
|
|
169 (defgroup comm nil
|
|
|
170 "Communications, networking, remote access to files."
|
|
|
171 :tag "Communication"
|
|
|
172 :group 'environment)
|
|
|
173
|
|
|
174 (defgroup hardware nil
|
|
|
175 "Support for interfacing with exotic hardware."
|
|
|
176 :group 'environment)
|
|
|
177
|
|
|
178 (defgroup terminals nil
|
|
|
179 "Support for terminal types."
|
|
|
180 :group 'environment)
|
|
|
181
|
|
|
182 (defgroup unix nil
|
|
|
183 "Front-ends/assistants for, or emulators of, UNIX features."
|
|
|
184 :group 'environment)
|
|
|
185
|
|
|
186 (defgroup vms nil
|
|
|
187 "Support code for vms."
|
|
|
188 :group 'environment)
|
|
|
189
|
|
|
190 (defgroup i18n nil
|
|
|
191 "Internationalization and alternate character-set support."
|
|
|
192 :group 'environment
|
|
|
193 :group 'editing)
|
|
|
194
|
|
149
|
195 (defgroup x nil
|
|
|
196 "The X Window system."
|
|
|
197 :group 'environment)
|
|
|
198
|
|
28
|
199 (defgroup frames nil
|
|
|
200 "Support for Emacs frames and window systems."
|
|
|
201 :group 'environment)
|
|
|
202
|
|
|
203 (defgroup data nil
|
|
|
204 "Support editing files of data."
|
|
|
205 :group 'emacs)
|
|
|
206
|
|
|
207 (defgroup wp nil
|
|
|
208 "Word processing."
|
|
|
209 :group 'emacs)
|
|
|
210
|
|
|
211 (defgroup tex nil
|
|
|
212 "Code related to the TeX formatter."
|
|
|
213 :group 'wp)
|
|
|
214
|
|
|
215 (defgroup faces nil
|
|
|
216 "Support for multiple fonts."
|
|
|
217 :group 'emacs)
|
|
|
218
|
|
|
219 (defgroup hypermedia nil
|
|
|
220 "Support for links between text or other media types."
|
|
|
221 :group 'emacs)
|
|
|
222
|
|
|
223 (defgroup help nil
|
|
|
224 "Support for on-line help systems."
|
|
|
225 :group 'emacs)
|
|
|
226
|
|
|
227 (defgroup local nil
|
|
|
228 "Code local to your site."
|
|
|
229 :group 'emacs)
|
|
|
230
|
|
|
231 (defgroup customize '((widgets custom-group))
|
|
|
232 "Customization of the Customization support."
|
|
|
233 :link '(custom-manual "(custom)Top")
|
|
|
234 :link '(url-link :tag "Development Page"
|
|
|
235 "http://www.dina.kvl.dk/~abraham/custom/")
|
|
|
236 :prefix "custom-"
|
|
124
|
237 :group 'help)
|
|
|
238
|
|
|
239 (defgroup custom-faces nil
|
|
|
240 "Faces used by customize."
|
|
|
241 :group 'customize
|
|
28
|
242 :group 'faces)
|
|
|
243
|
|
124
|
244 (defgroup abbrev-mode nil
|
|
|
245 "Word abbreviations mode."
|
|
|
246 :group 'abbrev)
|
|
|
247
|
|
|
248 (defgroup alloc nil
|
|
|
249 "Storage allocation and gc for GNU Emacs Lisp interpreter."
|
|
|
250 :tag "Storage Allocation"
|
|
|
251 :group 'internal)
|
|
|
252
|
|
|
253 (defgroup undo nil
|
|
|
254 "Undoing changes in buffers."
|
|
|
255 :group 'editing)
|
|
|
256
|
|
|
257 (defgroup modeline nil
|
|
|
258 "Content of the modeline."
|
|
|
259 :group 'environment)
|
|
|
260
|
|
|
261 (defgroup fill nil
|
|
|
262 "Indenting and filling text."
|
|
|
263 :group 'editing)
|
|
|
264
|
|
|
265 (defgroup editing-basics nil
|
|
|
266 "Most basic editing facilities."
|
|
|
267 :group 'editing)
|
|
|
268
|
|
|
269 (defgroup display nil
|
|
|
270 "How characters are displayed in buffers."
|
|
|
271 :group 'environment)
|
|
|
272
|
|
|
273 (defgroup execute nil
|
|
|
274 "Executing external commands."
|
|
|
275 :group 'processes)
|
|
|
276
|
|
|
277 (defgroup installation nil
|
|
|
278 "The Emacs installation."
|
|
|
279 :group 'environment)
|
|
|
280
|
|
|
281 (defgroup dired nil
|
|
|
282 "Directory editing."
|
|
|
283 :group 'environment)
|
|
|
284
|
|
|
285 (defgroup limits nil
|
|
|
286 "Internal Emacs limits."
|
|
|
287 :group 'internal)
|
|
|
288
|
|
|
289 (defgroup debug nil
|
|
|
290 "Debugging Emacs itself."
|
|
|
291 :group 'development)
|
|
|
292
|
|
|
293 (defgroup minibuffer nil
|
|
|
294 "Controling the behaviour of the minibuffer."
|
|
|
295 :group 'environment)
|
|
|
296
|
|
|
297 (defgroup keyboard nil
|
|
|
298 "Input from the keyboard."
|
|
|
299 :group 'environment)
|
|
|
300
|
|
|
301 (defgroup mouse nil
|
|
|
302 "Input from the mouse."
|
|
|
303 :group 'environment)
|
|
|
304
|
|
|
305 (defgroup menu nil
|
|
|
306 "Input from the menus."
|
|
|
307 :group 'environment)
|
|
|
308
|
|
|
309 (defgroup auto-save nil
|
|
|
310 "Preventing accidential loss of data."
|
|
|
311 :group 'data)
|
|
|
312
|
|
|
313 (defgroup processes-basics nil
|
|
|
314 "Basic stuff dealing with processes."
|
|
|
315 :group 'processes)
|
|
|
316
|
|
|
317 (defgroup windows nil
|
|
|
318 "Windows within a frame."
|
|
|
319 :group 'processes)
|
|
|
320
|
|
28
|
321 ;;; Utilities.
|
|
|
322
|
|
|
323 (defun custom-quote (sexp)
|
|
|
324 "Quote SEXP iff it is not self quoting."
|
|
|
325 (if (or (memq sexp '(t nil))
|
|
|
326 (and (symbolp sexp)
|
|
|
327 (eq (aref (symbol-name sexp) 0) ?:))
|
|
|
328 (and (listp sexp)
|
|
|
329 (memq (car sexp) '(lambda)))
|
|
|
330 (stringp sexp)
|
|
|
331 (numberp sexp)
|
|
|
332 (and (fboundp 'characterp)
|
|
|
333 (characterp sexp)))
|
|
|
334 sexp
|
|
|
335 (list 'quote sexp)))
|
|
|
336
|
|
|
337 (defun custom-split-regexp-maybe (regexp)
|
|
|
338 "If REGEXP is a string, split it to a list at `\\|'.
|
|
|
339 You can get the original back with from the result with:
|
|
|
340 (mapconcat 'identity result \"\\|\")
|
|
|
341
|
|
|
342 IF REGEXP is not a string, return it unchanged."
|
|
|
343 (if (stringp regexp)
|
|
|
344 (let ((start 0)
|
|
|
345 all)
|
|
|
346 (while (string-match "\\\\|" regexp start)
|
|
|
347 (setq all (cons (substring regexp start (match-beginning 0)) all)
|
|
|
348 start (match-end 0)))
|
|
|
349 (nreverse (cons (substring regexp start) all)))
|
|
|
350 regexp))
|
|
|
351
|
|
124
|
352 (defun custom-variable-prompt ()
|
|
|
353 ;; Code stolen from `help.el'.
|
|
|
354 "Prompt for a variable, defaulting to the variable at point.
|
|
|
355 Return a list suitable for use in `interactive'."
|
|
|
356 (let ((v (variable-at-point))
|
|
|
357 (enable-recursive-minibuffers t)
|
|
|
358 val)
|
|
|
359 (setq val (completing-read
|
|
|
360 (if v
|
|
149
|
361 (format "Customize variable: (default %s) " v)
|
|
124
|
362 "Customize variable: ")
|
|
149
|
363 obarray (lambda (symbol)
|
|
|
364 (and (boundp symbol)
|
|
|
365 (or (get symbol 'custom-type)
|
|
|
366 (user-variable-p symbol))))))
|
|
124
|
367 (list (if (equal val "")
|
|
|
368 v (intern val)))))
|
|
|
369
|
|
149
|
370 (defun custom-menu-filter (menu widget)
|
|
|
371 "Convert MENU to the form used by `widget-choose'.
|
|
|
372 MENU should be in the same format as `custom-variable-menu'.
|
|
|
373 WIDGET is the widget to apply the filter entries of MENU on."
|
|
|
374 (let ((result nil)
|
|
|
375 current name action filter)
|
|
|
376 (while menu
|
|
|
377 (setq current (car menu)
|
|
|
378 name (nth 0 current)
|
|
|
379 action (nth 1 current)
|
|
|
380 filter (nth 2 current)
|
|
|
381 menu (cdr menu))
|
|
|
382 (if (or (null filter) (funcall filter widget))
|
|
|
383 (push (cons name action) result)
|
|
|
384 (push name result)))
|
|
|
385 (nreverse result)))
|
|
|
386
|
|
124
|
387 ;;; Unlispify.
|
|
|
388
|
|
28
|
389 (defvar custom-prefix-list nil
|
|
|
390 "List of prefixes that should be ignored by `custom-unlispify'")
|
|
|
391
|
|
|
392 (defcustom custom-unlispify-menu-entries t
|
|
|
393 "Display menu entries as words instead of symbols if non nil."
|
|
|
394 :group 'customize
|
|
|
395 :type 'boolean)
|
|
|
396
|
|
|
397 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
|
|
|
398 "Convert symbol into a menu entry."
|
|
|
399 (cond ((not custom-unlispify-menu-entries)
|
|
|
400 (symbol-name symbol))
|
|
|
401 ((get symbol 'custom-tag)
|
|
|
402 (if no-suffix
|
|
|
403 (get symbol 'custom-tag)
|
|
|
404 (concat (get symbol 'custom-tag) "...")))
|
|
|
405 (t
|
|
|
406 (save-excursion
|
|
|
407 (set-buffer (get-buffer-create " *Custom-Work*"))
|
|
|
408 (erase-buffer)
|
|
|
409 (princ symbol (current-buffer))
|
|
|
410 (goto-char (point-min))
|
|
120
|
411 (when (and (eq (get symbol 'custom-type) 'boolean)
|
|
|
412 (re-search-forward "-p\\'" nil t))
|
|
|
413 (replace-match "" t t)
|
|
|
414 (goto-char (point-min)))
|
|
28
|
415 (let ((prefixes custom-prefix-list)
|
|
|
416 prefix)
|
|
|
417 (while prefixes
|
|
|
418 (setq prefix (car prefixes))
|
|
|
419 (if (search-forward prefix (+ (point) (length prefix)) t)
|
|
|
420 (progn
|
|
|
421 (setq prefixes nil)
|
|
|
422 (delete-region (point-min) (point)))
|
|
|
423 (setq prefixes (cdr prefixes)))))
|
|
|
424 (subst-char-in-region (point-min) (point-max) ?- ?\ t)
|
|
|
425 (capitalize-region (point-min) (point-max))
|
|
|
426 (unless no-suffix
|
|
|
427 (goto-char (point-max))
|
|
|
428 (insert "..."))
|
|
|
429 (buffer-string)))))
|
|
|
430
|
|
|
431 (defcustom custom-unlispify-tag-names t
|
|
|
432 "Display tag names as words instead of symbols if non nil."
|
|
|
433 :group 'customize
|
|
|
434 :type 'boolean)
|
|
|
435
|
|
|
436 (defun custom-unlispify-tag-name (symbol)
|
|
|
437 "Convert symbol into a menu entry."
|
|
|
438 (let ((custom-unlispify-menu-entries custom-unlispify-tag-names))
|
|
|
439 (custom-unlispify-menu-entry symbol t)))
|
|
|
440
|
|
|
441 (defun custom-prefix-add (symbol prefixes)
|
|
|
442 ;; Addd SYMBOL to list of ignored PREFIXES.
|
|
|
443 (cons (or (get symbol 'custom-prefix)
|
|
|
444 (concat (symbol-name symbol) "-"))
|
|
|
445 prefixes))
|
|
|
446
|
|
124
|
447 ;;; Guess.
|
|
|
448
|
|
|
449 (defcustom custom-guess-name-alist
|
|
120
|
450 '(("-p\\'" boolean)
|
|
|
451 ("-hook\\'" hook)
|
|
|
452 ("-face\\'" face)
|
|
|
453 ("-file\\'" file)
|
|
|
454 ("-function\\'" function)
|
|
|
455 ("-functions\\'" (repeat function))
|
|
|
456 ("-list\\'" (repeat sexp))
|
|
|
457 ("-alist\\'" (repeat (cons sexp sexp))))
|
|
|
458 "Alist of (MATCH TYPE).
|
|
|
459
|
|
|
460 MATCH should be a regexp matching the name of a symbol, and TYPE should
|
|
|
461 be a widget suitable for editing the value of that symbol. The TYPE
|
|
|
462 of the first entry where MATCH matches the name of the symbol will be
|
|
|
463 used.
|
|
|
464
|
|
|
465 This is used for guessing the type of variables not declared with
|
|
|
466 customize."
|
|
124
|
467 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
|
|
|
468 :group 'customize)
|
|
|
469
|
|
|
470 (defcustom custom-guess-doc-alist
|
|
|
471 '(("\\`\\*?Non-nil " boolean))
|
|
|
472 "Alist of (MATCH TYPE).
|
|
|
473
|
|
|
474 MATCH should be a regexp matching a documentation string, and TYPE
|
|
|
475 should be a widget suitable for editing the value of a variable with
|
|
|
476 that documentation string. The TYPE of the first entry where MATCH
|
|
|
477 matches the name of the symbol will be used.
|
|
|
478
|
|
|
479 This is used for guessing the type of variables not declared with
|
|
|
480 customize."
|
|
|
481 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
|
|
120
|
482 :group 'customize)
|
|
|
483
|
|
|
484 (defun custom-guess-type (symbol)
|
|
|
485 "Guess a widget suitable for editing the value of SYMBOL.
|
|
124
|
486 This is done by matching SYMBOL with `custom-guess-name-alist' and
|
|
|
487 if that fails, the doc string with `custom-guess-doc-alist'."
|
|
120
|
488 (let ((name (symbol-name symbol))
|
|
124
|
489 (names custom-guess-name-alist)
|
|
120
|
490 current found)
|
|
124
|
491 (while names
|
|
|
492 (setq current (car names)
|
|
|
493 names (cdr names))
|
|
120
|
494 (when (string-match (nth 0 current) name)
|
|
|
495 (setq found (nth 1 current)
|
|
124
|
496 names nil)))
|
|
|
497 (unless found
|
|
|
498 (let ((doc (documentation-property symbol 'variable-documentation))
|
|
|
499 (docs custom-guess-doc-alist))
|
|
|
500 (when doc
|
|
|
501 (while docs
|
|
|
502 (setq current (car docs)
|
|
|
503 docs (cdr docs))
|
|
|
504 (when (string-match (nth 0 current) doc)
|
|
|
505 (setq found (nth 1 current)
|
|
|
506 docs nil))))))
|
|
120
|
507 found))
|
|
|
508
|
|
124
|
509 ;;; Custom Mode Commands.
|
|
28
|
510
|
|
|
511 (defvar custom-options nil
|
|
|
512 "Customization widgets in the current buffer.")
|
|
|
513
|
|
|
514 (defun custom-set ()
|
|
|
515 "Set changes in all modified options."
|
|
|
516 (interactive)
|
|
|
517 (let ((children custom-options))
|
|
|
518 (mapcar (lambda (child)
|
|
|
519 (when (eq (widget-get child :custom-state) 'modified)
|
|
|
520 (widget-apply child :custom-set)))
|
|
|
521 children)))
|
|
|
522
|
|
|
523 (defun custom-save ()
|
|
|
524 "Set all modified group members and save them."
|
|
|
525 (interactive)
|
|
|
526 (let ((children custom-options))
|
|
|
527 (mapcar (lambda (child)
|
|
|
528 (when (memq (widget-get child :custom-state) '(modified set))
|
|
|
529 (widget-apply child :custom-save)))
|
|
|
530 children))
|
|
|
531 (custom-save-all))
|
|
|
532
|
|
|
533 (defvar custom-reset-menu
|
|
|
534 '(("Current" . custom-reset-current)
|
|
|
535 ("Saved" . custom-reset-saved)
|
|
|
536 ("Factory Settings" . custom-reset-factory))
|
|
|
537 "Alist of actions for the `Reset' button.
|
|
|
538 The key is a string containing the name of the action, the value is a
|
|
|
539 lisp function taking the widget as an element which will be called
|
|
|
540 when the action is chosen.")
|
|
|
541
|
|
|
542 (defun custom-reset (event)
|
|
|
543 "Select item from reset menu."
|
|
|
544 (let* ((completion-ignore-case t)
|
|
|
545 (answer (widget-choose "Reset to"
|
|
|
546 custom-reset-menu
|
|
|
547 event)))
|
|
|
548 (if answer
|
|
|
549 (funcall answer))))
|
|
|
550
|
|
|
551 (defun custom-reset-current ()
|
|
|
552 "Reset all modified group members to their current value."
|
|
|
553 (interactive)
|
|
|
554 (let ((children custom-options))
|
|
|
555 (mapcar (lambda (child)
|
|
|
556 (when (eq (widget-get child :custom-state) 'modified)
|
|
|
557 (widget-apply child :custom-reset-current)))
|
|
|
558 children)))
|
|
|
559
|
|
|
560 (defun custom-reset-saved ()
|
|
|
561 "Reset all modified or set group members to their saved value."
|
|
|
562 (interactive)
|
|
|
563 (let ((children custom-options))
|
|
|
564 (mapcar (lambda (child)
|
|
|
565 (when (eq (widget-get child :custom-state) 'modified)
|
|
|
566 (widget-apply child :custom-reset-current)))
|
|
|
567 children)))
|
|
|
568
|
|
|
569 (defun custom-reset-factory ()
|
|
|
570 "Reset all modified, set, or saved group members to their factory settings."
|
|
|
571 (interactive)
|
|
|
572 (let ((children custom-options))
|
|
|
573 (mapcar (lambda (child)
|
|
|
574 (when (eq (widget-get child :custom-state) 'modified)
|
|
|
575 (widget-apply child :custom-reset-current)))
|
|
|
576 children)))
|
|
|
577
|
|
|
578 ;;; The Customize Commands
|
|
|
579
|
|
149
|
580 (defun custom-prompt-variable (prompt-var prompt-val)
|
|
|
581 "Prompt for a variable and a value and return them as a list.
|
|
|
582 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
|
|
|
583 prompt for the value. The %s escape in PROMPT-VAL is replaced with
|
|
|
584 the name of the variable.
|
|
|
585
|
|
|
586 If the variable has a `variable-interactive' property, that is used as if
|
|
|
587 it were the arg to `interactive' (which see) to interactively read the value.
|
|
|
588
|
|
|
589 If the variable has a `custom-type' property, it must be a widget and the
|
|
|
590 `:prompt-value' property of that widget will be used for reading the value."
|
|
|
591 (let* ((var (read-variable prompt-var))
|
|
|
592 (minibuffer-help-form '(describe-variable var)))
|
|
|
593 (list var
|
|
|
594 (let ((prop (get var 'variable-interactive))
|
|
|
595 (type (get var 'custom-type))
|
|
|
596 (prompt (format prompt-val var)))
|
|
|
597 (unless (listp type)
|
|
|
598 (setq type (list type)))
|
|
|
599 (cond (prop
|
|
|
600 ;; Use VAR's `variable-interactive' property
|
|
|
601 ;; as an interactive spec for prompting.
|
|
|
602 (call-interactively (list 'lambda '(arg)
|
|
|
603 (list 'interactive prop)
|
|
|
604 'arg)))
|
|
|
605 (type
|
|
|
606 (widget-prompt-value type
|
|
|
607 prompt
|
|
|
608 (if (boundp var)
|
|
|
609 (symbol-value var))
|
|
|
610 (not (boundp var))))
|
|
|
611 (t
|
|
|
612 (eval-minibuffer prompt)))))))
|
|
|
613
|
|
|
614 ;;;###autoload
|
|
|
615 (defun custom-set-value (var val)
|
|
|
616 "Set VARIABLE to VALUE. VALUE is a Lisp object.
|
|
|
617
|
|
|
618 If VARIABLE has a `variable-interactive' property, that is used as if
|
|
|
619 it were the arg to `interactive' (which see) to interactively read the value.
|
|
|
620
|
|
|
621 If VARIABLE has a `custom-type' property, it must be a widget and the
|
|
|
622 `:prompt-value' property of that widget will be used for reading the value."
|
|
|
623 (interactive (custom-prompt-variable "Set variable: "
|
|
|
624 "Set %s to value: "))
|
|
|
625
|
|
|
626 (set var val))
|
|
|
627
|
|
|
628 ;;;###autoload
|
|
|
629 (defun custom-set-variable (var val)
|
|
|
630 "Set the default for VARIABLE to VALUE. VALUE is a Lisp object.
|
|
|
631
|
|
|
632 If VARIABLE has a `custom-set' property, that is used for setting
|
|
|
633 VARIABLE, otherwise `set-default' is used.
|
|
|
634
|
|
|
635 The `customized-value' property of the VARIABLE will be set to a list
|
|
|
636 with a quoted VALUE as its sole list member.
|
|
|
637
|
|
|
638 If VARIABLE has a `variable-interactive' property, that is used as if
|
|
|
639 it were the arg to `interactive' (which see) to interactively read the value.
|
|
|
640
|
|
|
641 If VARIABLE has a `custom-type' property, it must be a widget and the
|
|
|
642 `:prompt-value' property of that widget will be used for reading the value. "
|
|
|
643 (interactive (custom-prompt-variable "Set variable: "
|
|
|
644 "Set customized value for %s to: "))
|
|
|
645 (funcall (or (get var 'custom-set) 'set-default) var val)
|
|
|
646 (put var 'customized-value (list (custom-quote val))))
|
|
|
647
|
|
28
|
648 ;;;###autoload
|
|
|
649 (defun customize (symbol)
|
|
|
650 "Customize SYMBOL, which must be a customization group."
|
|
|
651 (interactive (list (completing-read "Customize group: (default emacs) "
|
|
|
652 obarray
|
|
|
653 (lambda (symbol)
|
|
|
654 (get symbol 'custom-group))
|
|
|
655 t)))
|
|
|
656
|
|
|
657 (when (stringp symbol)
|
|
|
658 (if (string-equal "" symbol)
|
|
|
659 (setq symbol 'emacs)
|
|
|
660 (setq symbol (intern symbol))))
|
|
149
|
661 (custom-buffer-create (list (list symbol 'custom-group))
|
|
|
662 (format "*Customize Group: %s*"
|
|
|
663 (custom-unlispify-tag-name symbol))))
|
|
|
664
|
|
|
665 ;;;###autoload
|
|
|
666 (defun customize-other-window (symbol)
|
|
|
667 "Customize SYMBOL, which must be a customization group."
|
|
|
668 (interactive (list (completing-read "Customize group: (default emacs) "
|
|
|
669 obarray
|
|
|
670 (lambda (symbol)
|
|
|
671 (get symbol 'custom-group))
|
|
|
672 t)))
|
|
|
673
|
|
|
674 (when (stringp symbol)
|
|
|
675 (if (string-equal "" symbol)
|
|
|
676 (setq symbol 'emacs)
|
|
|
677 (setq symbol (intern symbol))))
|
|
|
678 (custom-buffer-create-other-window
|
|
|
679 (list (list symbol 'custom-group))
|
|
|
680 (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
|
|
28
|
681
|
|
|
682 ;;;###autoload
|
|
|
683 (defun customize-variable (symbol)
|
|
|
684 "Customize SYMBOL, which must be a variable."
|
|
124
|
685 (interactive (custom-variable-prompt))
|
|
149
|
686 (custom-buffer-create (list (list symbol 'custom-variable))
|
|
|
687 (format "*Customize Variable: %s*"
|
|
|
688 (custom-unlispify-tag-name symbol))))
|
|
28
|
689
|
|
|
690 ;;;###autoload
|
|
124
|
691 (defun customize-variable-other-window (symbol)
|
|
|
692 "Customize SYMBOL, which must be a variable.
|
|
|
693 Show the buffer in another window, but don't select it."
|
|
|
694 (interactive (custom-variable-prompt))
|
|
149
|
695 (custom-buffer-create-other-window
|
|
|
696 (list (list symbol 'custom-variable))
|
|
|
697 (format "*Customize Variable: %s*" (custom-unlispify-tag-name symbol))))
|
|
124
|
698
|
|
|
699 ;;;###autoload
|
|
28
|
700 (defun customize-face (&optional symbol)
|
|
|
701 "Customize SYMBOL, which should be a face name or nil.
|
|
|
702 If SYMBOL is nil, customize all faces."
|
|
|
703 (interactive (list (completing-read "Customize face: (default all) "
|
|
|
704 obarray 'custom-facep)))
|
|
|
705 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
|
|
|
706 (let ((found nil))
|
|
|
707 (message "Looking for faces...")
|
|
|
708 (mapcar (lambda (symbol)
|
|
|
709 (setq found (cons (list symbol 'custom-face) found)))
|
|
124
|
710 (nreverse (mapcar 'intern
|
|
|
711 (sort (mapcar 'symbol-name (face-list))
|
|
|
712 'string<))))
|
|
|
713
|
|
149
|
714 (custom-buffer-create found "*Customize Faces*"))
|
|
28
|
715 (if (stringp symbol)
|
|
|
716 (setq symbol (intern symbol)))
|
|
|
717 (unless (symbolp symbol)
|
|
|
718 (error "Should be a symbol %S" symbol))
|
|
149
|
719 (custom-buffer-create (list (list symbol 'custom-face))
|
|
|
720 (format "*Customize Face: %s*"
|
|
|
721 (custom-unlispify-tag-name symbol)))))
|
|
28
|
722
|
|
|
723 ;;;###autoload
|
|
124
|
724 (defun customize-face-other-window (&optional symbol)
|
|
|
725 "Show customization buffer for FACE in other window."
|
|
|
726 (interactive (list (completing-read "Customize face: "
|
|
|
727 obarray 'custom-facep)))
|
|
|
728 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
|
|
|
729 ()
|
|
|
730 (if (stringp symbol)
|
|
|
731 (setq symbol (intern symbol)))
|
|
|
732 (unless (symbolp symbol)
|
|
|
733 (error "Should be a symbol %S" symbol))
|
|
149
|
734 (custom-buffer-create-other-window
|
|
|
735 (list (list symbol 'custom-face))
|
|
|
736 (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
|
|
124
|
737
|
|
|
738 ;;;###autoload
|
|
28
|
739 (defun customize-customized ()
|
|
149
|
740 "Customize all user options set since the last save in this session."
|
|
|
741 (interactive)
|
|
|
742 (let ((found nil))
|
|
|
743 (mapatoms (lambda (symbol)
|
|
|
744 (and (get symbol 'customized-face)
|
|
|
745 (custom-facep symbol)
|
|
|
746 (setq found (cons (list symbol 'custom-face) found)))
|
|
|
747 (and (get symbol 'customized-value)
|
|
|
748 (boundp symbol)
|
|
|
749 (setq found
|
|
|
750 (cons (list symbol 'custom-variable) found)))))
|
|
|
751 (if found
|
|
|
752 (custom-buffer-create found "*Customize Customized*")
|
|
|
753 (error "No customized user options"))))
|
|
|
754
|
|
|
755 ;;;###autoload
|
|
|
756 (defun customize-saved ()
|
|
|
757 "Customize all already saved user options."
|
|
28
|
758 (interactive)
|
|
|
759 (let ((found nil))
|
|
|
760 (mapatoms (lambda (symbol)
|
|
|
761 (and (get symbol 'saved-face)
|
|
|
762 (custom-facep symbol)
|
|
|
763 (setq found (cons (list symbol 'custom-face) found)))
|
|
|
764 (and (get symbol 'saved-value)
|
|
|
765 (boundp symbol)
|
|
|
766 (setq found
|
|
|
767 (cons (list symbol 'custom-variable) found)))))
|
|
|
768 (if found
|
|
149
|
769 (custom-buffer-create found "*Customize Saved*")
|
|
|
770 (error "No saved user options"))))
|
|
28
|
771
|
|
|
772 ;;;###autoload
|
|
|
773 (defun customize-apropos (regexp &optional all)
|
|
|
774 "Customize all user options matching REGEXP.
|
|
|
775 If ALL (e.g., started with a prefix key), include options which are not
|
|
|
776 user-settable."
|
|
|
777 (interactive "sCustomize regexp: \nP")
|
|
|
778 (let ((found nil))
|
|
|
779 (mapatoms (lambda (symbol)
|
|
|
780 (when (string-match regexp (symbol-name symbol))
|
|
|
781 (when (get symbol 'custom-group)
|
|
|
782 (setq found (cons (list symbol 'custom-group) found)))
|
|
|
783 (when (custom-facep symbol)
|
|
|
784 (setq found (cons (list symbol 'custom-face) found)))
|
|
|
785 (when (and (boundp symbol)
|
|
|
786 (or (get symbol 'saved-value)
|
|
|
787 (get symbol 'factory-value)
|
|
|
788 (if all
|
|
|
789 (get symbol 'variable-documentation)
|
|
|
790 (user-variable-p symbol))))
|
|
|
791 (setq found
|
|
|
792 (cons (list symbol 'custom-variable) found))))))
|
|
|
793 (if found
|
|
149
|
794 (custom-buffer-create found "*Customize Apropos*")
|
|
28
|
795 (error "No matches"))))
|
|
|
796
|
|
149
|
797 ;;; Buffer.
|
|
|
798
|
|
28
|
799 ;;;###autoload
|
|
149
|
800 (defun custom-buffer-create (options &optional name)
|
|
28
|
801 "Create a buffer containing OPTIONS.
|
|
149
|
802 Optional NAME is the name of the buffer.
|
|
28
|
803 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
|
|
|
804 SYMBOL is a customization option, and WIDGET is a widget for editing
|
|
|
805 that option."
|
|
149
|
806 (unless name (setq name "*Customization*"))
|
|
|
807 (kill-buffer (get-buffer-create name))
|
|
|
808 (switch-to-buffer (get-buffer-create name))
|
|
124
|
809 (custom-buffer-create-internal options))
|
|
|
810
|
|
149
|
811 ;;;###autoload
|
|
|
812 (defun custom-buffer-create-other-window (options &optional name)
|
|
124
|
813 "Create a buffer containing OPTIONS.
|
|
149
|
814 Optional NAME is the name of the buffer.
|
|
124
|
815 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
|
|
|
816 SYMBOL is a customization option, and WIDGET is a widget for editing
|
|
|
817 that option."
|
|
149
|
818 (unless name (setq name "*Customization*"))
|
|
|
819 (kill-buffer (get-buffer-create name))
|
|
124
|
820 (let ((window (selected-window)))
|
|
149
|
821 (switch-to-buffer-other-window (get-buffer-create name))
|
|
124
|
822 (custom-buffer-create-internal options)
|
|
|
823 (select-window window)))
|
|
|
824
|
|
|
825
|
|
|
826 (defun custom-buffer-create-internal (options)
|
|
|
827 (message "Creating customization buffer...")
|
|
28
|
828 (custom-mode)
|
|
|
829 (widget-insert "This is a customization buffer.
|
|
|
830 Push RET or click mouse-2 on the word ")
|
|
116
|
831 ;; (put-text-property 1 2 'start-open nil)
|
|
28
|
832 (widget-create 'info-link
|
|
|
833 :tag "help"
|
|
30
|
834 :help-echo "Read the online help."
|
|
28
|
835 "(custom)The Customization Buffer")
|
|
|
836 (widget-insert " for more information.\n\n")
|
|
|
837 (setq custom-options
|
|
120
|
838 (if (= (length options) 1)
|
|
|
839 (mapcar (lambda (entry)
|
|
|
840 (widget-create (nth 1 entry)
|
|
|
841 :custom-state 'unknown
|
|
|
842 :tag (custom-unlispify-tag-name
|
|
|
843 (nth 0 entry))
|
|
|
844 :value (nth 0 entry)))
|
|
|
845 options)
|
|
|
846 (let ((count 0)
|
|
|
847 (length (length options)))
|
|
|
848 (mapcar (lambda (entry)
|
|
|
849 (prog2
|
|
|
850 (message "Creating customization items %2d%%..."
|
|
|
851 (/ (* 100.0 count) length))
|
|
|
852 (widget-create (nth 1 entry)
|
|
28
|
853 :tag (custom-unlispify-tag-name
|
|
|
854 (nth 0 entry))
|
|
|
855 :value (nth 0 entry))
|
|
120
|
856 (setq count (1+ count))
|
|
|
857 (unless (eq (preceding-char) ?\n)
|
|
|
858 (widget-insert "\n"))
|
|
|
859 (widget-insert "\n")))
|
|
|
860 options))))
|
|
|
861 (unless (eq (preceding-char) ?\n)
|
|
|
862 (widget-insert "\n"))
|
|
|
863 (widget-insert "\n")
|
|
|
864 (message "Creating customization magic...")
|
|
28
|
865 (mapcar 'custom-magic-reset custom-options)
|
|
120
|
866 (message "Creating customization buttons...")
|
|
28
|
867 (widget-create 'push-button
|
|
|
868 :tag "Set"
|
|
30
|
869 :help-echo "Set all modifications for this session."
|
|
28
|
870 :action (lambda (widget &optional event)
|
|
|
871 (custom-set)))
|
|
|
872 (widget-insert " ")
|
|
|
873 (widget-create 'push-button
|
|
|
874 :tag "Save"
|
|
30
|
875 :help-echo "\
|
|
|
876 Make the modifications default for future sessions."
|
|
28
|
877 :action (lambda (widget &optional event)
|
|
|
878 (custom-save)))
|
|
|
879 (widget-insert " ")
|
|
|
880 (widget-create 'push-button
|
|
|
881 :tag "Reset"
|
|
30
|
882 :help-echo "Undo all modifications."
|
|
28
|
883 :action (lambda (widget &optional event)
|
|
|
884 (custom-reset event)))
|
|
|
885 (widget-insert " ")
|
|
|
886 (widget-create 'push-button
|
|
|
887 :tag "Done"
|
|
30
|
888 :help-echo "Bury the buffer."
|
|
28
|
889 :action (lambda (widget &optional event)
|
|
149
|
890 (bury-buffer)))
|
|
28
|
891 (widget-insert "\n")
|
|
120
|
892 (message "Creating customization setup...")
|
|
30
|
893 (widget-setup)
|
|
120
|
894 (goto-char (point-min))
|
|
149
|
895 (when (fboundp 'map-extents)
|
|
|
896 ;; This horrible kludge should make bob and eob read-only in XEmacs.
|
|
|
897 (map-extents (lambda (extent &rest junk)
|
|
|
898 (set-extent-property extent 'start-closed t))
|
|
|
899 nil (point-min) (1+ (point-min)))
|
|
|
900 (map-extents (lambda (extent &rest junk)
|
|
|
901 (set-extent-property extent 'end-closed t))
|
|
|
902 nil (1- (point-max)) (point-max)))
|
|
120
|
903 (message "Creating customization buffer...done"))
|
|
28
|
904
|
|
|
905 ;;; Modification of Basic Widgets.
|
|
|
906 ;;
|
|
|
907 ;; We add extra properties to the basic widgets needed here. This is
|
|
|
908 ;; fine, as long as we are careful to stay within out own namespace.
|
|
|
909 ;;
|
|
|
910 ;; We want simple widgets to be displayed by default, but complex
|
|
|
911 ;; widgets to be hidden.
|
|
|
912
|
|
|
913 (widget-put (get 'item 'widget-type) :custom-show t)
|
|
|
914 (widget-put (get 'editable-field 'widget-type)
|
|
|
915 :custom-show (lambda (widget value)
|
|
|
916 (let ((pp (pp-to-string value)))
|
|
|
917 (cond ((string-match "\n" pp)
|
|
|
918 nil)
|
|
|
919 ((> (length pp) 40)
|
|
|
920 nil)
|
|
|
921 (t t)))))
|
|
|
922 (widget-put (get 'menu-choice 'widget-type) :custom-show t)
|
|
|
923
|
|
|
924 ;;; The `custom-manual' Widget.
|
|
|
925
|
|
|
926 (define-widget 'custom-manual 'info-link
|
|
|
927 "Link to the manual entry for this customization option."
|
|
30
|
928 :help-echo "Read the manual entry for this option."
|
|
28
|
929 :tag "Manual")
|
|
|
930
|
|
|
931 ;;; The `custom-magic' Widget.
|
|
|
932
|
|
|
933 (defface custom-invalid-face '((((class color))
|
|
|
934 (:foreground "yellow" :background "red"))
|
|
|
935 (t
|
|
|
936 (:bold t :italic t :underline t)))
|
|
|
937 "Face used when the customize item is invalid.")
|
|
|
938
|
|
|
939 (defface custom-rogue-face '((((class color))
|
|
|
940 (:foreground "pink" :background "black"))
|
|
|
941 (t
|
|
|
942 (:underline t)))
|
|
|
943 "Face used when the customize item is not defined for customization.")
|
|
|
944
|
|
|
945 (defface custom-modified-face '((((class color))
|
|
|
946 (:foreground "white" :background "blue"))
|
|
|
947 (t
|
|
|
948 (:italic t :bold)))
|
|
|
949 "Face used when the customize item has been modified.")
|
|
|
950
|
|
|
951 (defface custom-set-face '((((class color))
|
|
|
952 (:foreground "blue" :background "white"))
|
|
|
953 (t
|
|
|
954 (:italic t)))
|
|
|
955 "Face used when the customize item has been set.")
|
|
|
956
|
|
|
957 (defface custom-changed-face '((((class color))
|
|
|
958 (:foreground "white" :background "blue"))
|
|
|
959 (t
|
|
|
960 (:italic t)))
|
|
|
961 "Face used when the customize item has been changed.")
|
|
|
962
|
|
|
963 (defface custom-saved-face '((t (:underline t)))
|
|
|
964 "Face used when the customize item has been saved.")
|
|
|
965
|
|
|
966 (defcustom custom-magic-alist '((nil "#" underline "\
|
|
|
967 uninitialized, you should not see this.")
|
|
|
968 (unknown "?" italic "\
|
|
|
969 unknown, you should not see this.")
|
|
|
970 (hidden "-" default "\
|
|
|
971 hidden, press the state button to show.")
|
|
|
972 (invalid "x" custom-invalid-face "\
|
|
|
973 the value displayed for this item is invalid and cannot be set.")
|
|
|
974 (modified "*" custom-modified-face "\
|
|
|
975 you have edited the item, and can now set it.")
|
|
|
976 (set "+" custom-set-face "\
|
|
|
977 you have set this item, but not saved it.")
|
|
|
978 (changed ":" custom-changed-face "\
|
|
|
979 this item has been changed outside customize.")
|
|
|
980 (saved "!" custom-saved-face "\
|
|
|
981 this item has been saved.")
|
|
|
982 (rogue "@" custom-rogue-face "\
|
|
|
983 this item is not prepared for customization.")
|
|
|
984 (factory " " nil "\
|
|
|
985 this item is unchanged from its factory setting."))
|
|
|
986 "Alist of customize option states.
|
|
|
987 Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where
|
|
|
988
|
|
|
989 STATE is one of the following symbols:
|
|
|
990
|
|
|
991 `nil'
|
|
|
992 For internal use, should never occur.
|
|
|
993 `unknown'
|
|
|
994 For internal use, should never occur.
|
|
|
995 `hidden'
|
|
|
996 This item is not being displayed.
|
|
|
997 `invalid'
|
|
|
998 This item is modified, but has an invalid form.
|
|
|
999 `modified'
|
|
|
1000 This item is modified, and has a valid form.
|
|
|
1001 `set'
|
|
|
1002 This item has been set but not saved.
|
|
|
1003 `changed'
|
|
|
1004 The current value of this item has been changed temporarily.
|
|
|
1005 `saved'
|
|
|
1006 This item is marked for saving.
|
|
|
1007 `rogue'
|
|
|
1008 This item has no customization information.
|
|
|
1009 `factory'
|
|
|
1010 This item is unchanged from the factory default.
|
|
|
1011
|
|
|
1012 MAGIC is a string used to present that state.
|
|
|
1013
|
|
|
1014 FACE is a face used to present the state.
|
|
|
1015
|
|
|
1016 DESCRIPTION is a string describing the state.
|
|
|
1017
|
|
|
1018 The list should be sorted most significant first."
|
|
|
1019 :type '(list (checklist :inline t
|
|
|
1020 (group (const nil)
|
|
|
1021 (string :tag "Magic")
|
|
|
1022 face
|
|
|
1023 (string :tag "Description"))
|
|
|
1024 (group (const unknown)
|
|
|
1025 (string :tag "Magic")
|
|
|
1026 face
|
|
|
1027 (string :tag "Description"))
|
|
|
1028 (group (const hidden)
|
|
|
1029 (string :tag "Magic")
|
|
|
1030 face
|
|
|
1031 (string :tag "Description"))
|
|
|
1032 (group (const invalid)
|
|
|
1033 (string :tag "Magic")
|
|
|
1034 face
|
|
|
1035 (string :tag "Description"))
|
|
|
1036 (group (const modified)
|
|
|
1037 (string :tag "Magic")
|
|
|
1038 face
|
|
|
1039 (string :tag "Description"))
|
|
|
1040 (group (const set)
|
|
|
1041 (string :tag "Magic")
|
|
|
1042 face
|
|
|
1043 (string :tag "Description"))
|
|
|
1044 (group (const changed)
|
|
|
1045 (string :tag "Magic")
|
|
|
1046 face
|
|
|
1047 (string :tag "Description"))
|
|
|
1048 (group (const saved)
|
|
|
1049 (string :tag "Magic")
|
|
|
1050 face
|
|
|
1051 (string :tag "Description"))
|
|
|
1052 (group (const rogue)
|
|
|
1053 (string :tag "Magic")
|
|
|
1054 face
|
|
|
1055 (string :tag "Description"))
|
|
|
1056 (group (const factory)
|
|
|
1057 (string :tag "Magic")
|
|
|
1058 face
|
|
|
1059 (string :tag "Description")))
|
|
|
1060 (editable-list :inline t
|
|
|
1061 (group symbol
|
|
|
1062 (string :tag "Magic")
|
|
|
1063 face
|
|
|
1064 (string :tag "Description"))))
|
|
124
|
1065 :group 'customize
|
|
|
1066 :group 'custom-faces)
|
|
28
|
1067
|
|
|
1068 (defcustom custom-magic-show 'long
|
|
|
1069 "Show long description of the state of each customization option."
|
|
|
1070 :type '(choice (const :tag "no" nil)
|
|
|
1071 (const short)
|
|
|
1072 (const long))
|
|
|
1073 :group 'customize)
|
|
|
1074
|
|
|
1075 (defcustom custom-magic-show-button t
|
|
|
1076 "Show a magic button indicating the state of each customization option."
|
|
|
1077 :type 'boolean
|
|
|
1078 :group 'customize)
|
|
|
1079
|
|
|
1080 (define-widget 'custom-magic 'default
|
|
|
1081 "Show and manipulate state for a customization option."
|
|
|
1082 :format "%v"
|
|
149
|
1083 :action 'widget-parent-action
|
|
|
1084 :notify 'ignore
|
|
28
|
1085 :value-get 'ignore
|
|
|
1086 :value-create 'custom-magic-value-create
|
|
|
1087 :value-delete 'widget-children-value-delete)
|
|
|
1088
|
|
149
|
1089 (defun widget-magic-mouse-down-action (widget &optional event)
|
|
|
1090 ;; Non-nil unless hidden.
|
|
|
1091 (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
|
|
|
1092 :custom-state)
|
|
|
1093 'hidden)))
|
|
|
1094
|
|
28
|
1095 (defun custom-magic-value-create (widget)
|
|
|
1096 ;; Create compact status report for WIDGET.
|
|
|
1097 (let* ((parent (widget-get widget :parent))
|
|
|
1098 (state (widget-get parent :custom-state))
|
|
|
1099 (entry (assq state custom-magic-alist))
|
|
|
1100 (magic (nth 1 entry))
|
|
|
1101 (face (nth 2 entry))
|
|
|
1102 (text (nth 3 entry))
|
|
|
1103 (lisp (eq (widget-get parent :custom-form) 'lisp))
|
|
|
1104 children)
|
|
|
1105 (when custom-magic-show
|
|
149
|
1106 (push (widget-create-child-and-convert
|
|
|
1107 widget 'choice-item
|
|
|
1108 :help-echo "\
|
|
30
|
1109 Change the state of this item."
|
|
149
|
1110 :format "%[%t%]"
|
|
|
1111 :mouse-down-action 'widget-magic-mouse-down-action
|
|
|
1112 :tag "State")
|
|
28
|
1113 children)
|
|
|
1114 (insert ": ")
|
|
|
1115 (if (eq custom-magic-show 'long)
|
|
|
1116 (insert text)
|
|
|
1117 (insert (symbol-name state)))
|
|
|
1118 (when lisp
|
|
|
1119 (insert " (lisp)"))
|
|
|
1120 (insert "\n"))
|
|
|
1121 (when custom-magic-show-button
|
|
|
1122 (when custom-magic-show
|
|
|
1123 (let ((indent (widget-get parent :indent)))
|
|
|
1124 (when indent
|
|
|
1125 (insert-char ? indent))))
|
|
149
|
1126 (push (widget-create-child-and-convert
|
|
|
1127 widget 'choice-item
|
|
|
1128 :mouse-down-action 'widget-magic-mouse-down-action
|
|
|
1129 :button-face face
|
|
|
1130 :help-echo "Change the state."
|
|
|
1131 :format "%[%t%]"
|
|
|
1132 :tag (if lisp
|
|
|
1133 (concat "(" magic ")")
|
|
|
1134 (concat "[" magic "]")))
|
|
28
|
1135 children)
|
|
|
1136 (insert " "))
|
|
|
1137 (widget-put widget :children children)))
|
|
|
1138
|
|
|
1139 (defun custom-magic-reset (widget)
|
|
|
1140 "Redraw the :custom-magic property of WIDGET."
|
|
|
1141 (let ((magic (widget-get widget :custom-magic)))
|
|
|
1142 (widget-value-set magic (widget-value magic))))
|
|
|
1143
|
|
|
1144 ;;; The `custom-level' Widget.
|
|
|
1145
|
|
|
1146 (define-widget 'custom-level 'item
|
|
|
1147 "The custom level buttons."
|
|
|
1148 :format "%[%t%]"
|
|
30
|
1149 :help-echo "Expand or collapse this item."
|
|
28
|
1150 :action 'custom-level-action)
|
|
|
1151
|
|
|
1152 (defun custom-level-action (widget &optional event)
|
|
|
1153 "Toggle visibility for parent to WIDGET."
|
|
149
|
1154 (custom-toggle-hide (widget-get widget :parent)))
|
|
28
|
1155
|
|
|
1156 ;;; The `custom' Widget.
|
|
|
1157
|
|
|
1158 (define-widget 'custom 'default
|
|
|
1159 "Customize a user option."
|
|
|
1160 :convert-widget 'custom-convert-widget
|
|
|
1161 :format "%l%[%t%]: %v%m%h%a"
|
|
|
1162 :format-handler 'custom-format-handler
|
|
|
1163 :notify 'custom-notify
|
|
|
1164 :custom-level 1
|
|
|
1165 :custom-state 'hidden
|
|
|
1166 :documentation-property 'widget-subclass-responsibility
|
|
|
1167 :value-create 'widget-subclass-responsibility
|
|
|
1168 :value-delete 'widget-children-value-delete
|
|
149
|
1169 :value-get 'widget-value-value-get
|
|
|
1170 :validate 'widget-children-validate
|
|
28
|
1171 :match (lambda (widget value) (symbolp value)))
|
|
|
1172
|
|
|
1173 (defun custom-convert-widget (widget)
|
|
|
1174 ;; Initialize :value and :tag from :args in WIDGET.
|
|
|
1175 (let ((args (widget-get widget :args)))
|
|
|
1176 (when args
|
|
|
1177 (widget-put widget :value (widget-apply widget
|
|
|
1178 :value-to-internal (car args)))
|
|
|
1179 (widget-put widget :tag (custom-unlispify-tag-name (car args)))
|
|
|
1180 (widget-put widget :args nil)))
|
|
|
1181 widget)
|
|
|
1182
|
|
|
1183 (defun custom-format-handler (widget escape)
|
|
|
1184 ;; We recognize extra escape sequences.
|
|
|
1185 (let* ((buttons (widget-get widget :buttons))
|
|
|
1186 (state (widget-get widget :custom-state))
|
|
|
1187 (level (widget-get widget :custom-level)))
|
|
|
1188 (cond ((eq escape ?l)
|
|
|
1189 (when level
|
|
|
1190 (push (widget-create-child-and-convert
|
|
|
1191 widget 'custom-level (make-string level ?*))
|
|
|
1192 buttons)
|
|
|
1193 (widget-insert " ")
|
|
|
1194 (widget-put widget :buttons buttons)))
|
|
|
1195 ((eq escape ?L)
|
|
|
1196 (when (eq state 'hidden)
|
|
|
1197 (widget-insert " ...")))
|
|
|
1198 ((eq escape ?m)
|
|
|
1199 (and (eq (preceding-char) ?\n)
|
|
|
1200 (widget-get widget :indent)
|
|
|
1201 (insert-char ? (widget-get widget :indent)))
|
|
|
1202 (let ((magic (widget-create-child-and-convert
|
|
|
1203 widget 'custom-magic nil)))
|
|
|
1204 (widget-put widget :custom-magic magic)
|
|
|
1205 (push magic buttons)
|
|
|
1206 (widget-put widget :buttons buttons)))
|
|
|
1207 ((eq escape ?a)
|
|
|
1208 (let* ((symbol (widget-get widget :value))
|
|
|
1209 (links (get symbol 'custom-links))
|
|
|
1210 (many (> (length links) 2)))
|
|
|
1211 (when links
|
|
|
1212 (and (eq (preceding-char) ?\n)
|
|
|
1213 (widget-get widget :indent)
|
|
|
1214 (insert-char ? (widget-get widget :indent)))
|
|
|
1215 (insert "See also ")
|
|
|
1216 (while links
|
|
|
1217 (push (widget-create-child-and-convert widget (car links))
|
|
|
1218 buttons)
|
|
|
1219 (setq links (cdr links))
|
|
|
1220 (cond ((null links)
|
|
|
1221 (insert ".\n"))
|
|
|
1222 ((null (cdr links))
|
|
|
1223 (if many
|
|
|
1224 (insert ", and ")
|
|
|
1225 (insert " and ")))
|
|
|
1226 (t
|
|
|
1227 (insert ", "))))
|
|
|
1228 (widget-put widget :buttons buttons))))
|
|
|
1229 (t
|
|
|
1230 (widget-default-format-handler widget escape)))))
|
|
|
1231
|
|
|
1232 (defun custom-notify (widget &rest args)
|
|
|
1233 "Keep track of changes."
|
|
30
|
1234 (unless (memq (widget-get widget :custom-state) '(nil unknown hidden))
|
|
|
1235 (widget-put widget :custom-state 'modified))
|
|
28
|
1236 (let ((buffer-undo-list t))
|
|
|
1237 (custom-magic-reset widget))
|
|
|
1238 (apply 'widget-default-notify widget args))
|
|
|
1239
|
|
|
1240 (defun custom-redraw (widget)
|
|
|
1241 "Redraw WIDGET with current settings."
|
|
149
|
1242 (let ((line (count-lines (point-min) (point)))
|
|
|
1243 (column (current-column))
|
|
|
1244 (pos (point))
|
|
28
|
1245 (from (marker-position (widget-get widget :from)))
|
|
|
1246 (to (marker-position (widget-get widget :to))))
|
|
|
1247 (save-excursion
|
|
|
1248 (widget-value-set widget (widget-value widget))
|
|
|
1249 (custom-redraw-magic widget))
|
|
|
1250 (when (and (>= pos from) (<= pos to))
|
|
149
|
1251 (condition-case nil
|
|
|
1252 (progn
|
|
|
1253 (if (> column 0)
|
|
|
1254 (goto-line line)
|
|
|
1255 (goto-line (1+ line)))
|
|
|
1256 (move-to-column column))
|
|
|
1257 (error nil)))))
|
|
28
|
1258
|
|
|
1259 (defun custom-redraw-magic (widget)
|
|
|
1260 "Redraw WIDGET state with current settings."
|
|
|
1261 (while widget
|
|
|
1262 (let ((magic (widget-get widget :custom-magic)))
|
|
|
1263 (unless magic
|
|
|
1264 (debug))
|
|
|
1265 (widget-value-set magic (widget-value magic))
|
|
|
1266 (when (setq widget (widget-get widget :group))
|
|
|
1267 (custom-group-state-update widget))))
|
|
|
1268 (widget-setup))
|
|
|
1269
|
|
|
1270 (defun custom-show (widget value)
|
|
|
1271 "Non-nil if WIDGET should be shown with VALUE by default."
|
|
|
1272 (let ((show (widget-get widget :custom-show)))
|
|
|
1273 (cond ((null show)
|
|
|
1274 nil)
|
|
|
1275 ((eq t show)
|
|
|
1276 t)
|
|
|
1277 (t
|
|
|
1278 (funcall show widget value)))))
|
|
|
1279
|
|
124
|
1280 (defvar custom-load-recursion nil
|
|
|
1281 "Hack to avoid recursive dependencies.")
|
|
|
1282
|
|
28
|
1283 (defun custom-load-symbol (symbol)
|
|
|
1284 "Load all dependencies for SYMBOL."
|
|
124
|
1285 (unless custom-load-recursion
|
|
|
1286 (let ((custom-load-recursion t)
|
|
|
1287 (loads (get symbol 'custom-loads))
|
|
|
1288 load)
|
|
|
1289 (while loads
|
|
|
1290 (setq load (car loads)
|
|
|
1291 loads (cdr loads))
|
|
|
1292 (cond ((symbolp load)
|
|
|
1293 (condition-case nil
|
|
|
1294 (require load)
|
|
|
1295 (error nil)))
|
|
|
1296 ((assoc load load-history))
|
|
|
1297 (t
|
|
|
1298 (condition-case nil
|
|
|
1299 (load-library load)
|
|
|
1300 (error nil))))))))
|
|
28
|
1301
|
|
|
1302 (defun custom-load-widget (widget)
|
|
|
1303 "Load all dependencies for WIDGET."
|
|
|
1304 (custom-load-symbol (widget-value widget)))
|
|
|
1305
|
|
149
|
1306 (defun custom-toggle-hide (widget)
|
|
|
1307 "Toggle visibility of WIDGET."
|
|
|
1308 (let ((state (widget-get widget :custom-state)))
|
|
|
1309 (cond ((memq state '(invalid modified))
|
|
|
1310 (error "There are unset changes"))
|
|
|
1311 ((eq state 'hidden)
|
|
|
1312 (widget-put widget :custom-state 'unknown))
|
|
|
1313 (t
|
|
|
1314 (widget-put widget :custom-state 'hidden)))
|
|
|
1315 (custom-redraw widget)))
|
|
|
1316
|
|
28
|
1317 ;;; The `custom-variable' Widget.
|
|
|
1318
|
|
|
1319 (defface custom-variable-sample-face '((t (:underline t)))
|
|
|
1320 "Face used for unpushable variable tags."
|
|
124
|
1321 :group 'custom-faces)
|
|
28
|
1322
|
|
|
1323 (defface custom-variable-button-face '((t (:underline t :bold t)))
|
|
|
1324 "Face used for pushable variable tags."
|
|
124
|
1325 :group 'custom-faces)
|
|
28
|
1326
|
|
|
1327 (define-widget 'custom-variable 'custom
|
|
|
1328 "Customize variable."
|
|
|
1329 :format "%l%v%m%h%a"
|
|
30
|
1330 :help-echo "Set or reset this variable."
|
|
28
|
1331 :documentation-property 'variable-documentation
|
|
|
1332 :custom-state nil
|
|
|
1333 :custom-menu 'custom-variable-menu-create
|
|
|
1334 :custom-form 'edit
|
|
|
1335 :value-create 'custom-variable-value-create
|
|
|
1336 :action 'custom-variable-action
|
|
|
1337 :custom-set 'custom-variable-set
|
|
|
1338 :custom-save 'custom-variable-save
|
|
|
1339 :custom-reset-current 'custom-redraw
|
|
|
1340 :custom-reset-saved 'custom-variable-reset-saved
|
|
|
1341 :custom-reset-factory 'custom-variable-reset-factory)
|
|
|
1342
|
|
120
|
1343 (defun custom-variable-type (symbol)
|
|
|
1344 "Return a widget suitable for editing the value of SYMBOL.
|
|
|
1345 If SYMBOL has a `custom-type' property, use that.
|
|
|
1346 Otherwise, look up symbol in `custom-guess-type-alist'."
|
|
|
1347 (let* ((type (or (get symbol 'custom-type)
|
|
124
|
1348 (and (not (get symbol 'factory-value))
|
|
|
1349 (custom-guess-type symbol))
|
|
120
|
1350 'sexp))
|
|
|
1351 (options (get symbol 'custom-options))
|
|
|
1352 (tmp (if (listp type)
|
|
149
|
1353 (copy-sequence type)
|
|
120
|
1354 (list type))))
|
|
|
1355 (when options
|
|
|
1356 (widget-put tmp :options options))
|
|
|
1357 tmp))
|
|
|
1358
|
|
28
|
1359 (defun custom-variable-value-create (widget)
|
|
|
1360 "Here is where you edit the variables value."
|
|
|
1361 (custom-load-widget widget)
|
|
|
1362 (let* ((buttons (widget-get widget :buttons))
|
|
|
1363 (children (widget-get widget :children))
|
|
|
1364 (form (widget-get widget :custom-form))
|
|
|
1365 (state (widget-get widget :custom-state))
|
|
|
1366 (symbol (widget-get widget :value))
|
|
|
1367 (tag (widget-get widget :tag))
|
|
120
|
1368 (type (custom-variable-type symbol))
|
|
28
|
1369 (conv (widget-convert type))
|
|
149
|
1370 (get (or (get symbol 'custom-get) 'default-value))
|
|
28
|
1371 (value (if (default-boundp symbol)
|
|
149
|
1372 (funcall get symbol)
|
|
28
|
1373 (widget-get conv :value))))
|
|
|
1374 ;; If the widget is new, the child determine whether it is hidden.
|
|
|
1375 (cond (state)
|
|
|
1376 ((custom-show type value)
|
|
|
1377 (setq state 'unknown))
|
|
|
1378 (t
|
|
|
1379 (setq state 'hidden)))
|
|
|
1380 ;; If we don't know the state, see if we need to edit it in lisp form.
|
|
|
1381 (when (eq state 'unknown)
|
|
|
1382 (unless (widget-apply conv :match value)
|
|
|
1383 ;; (widget-apply (widget-convert type) :match value)
|
|
|
1384 (setq form 'lisp)))
|
|
|
1385 ;; Now we can create the child widget.
|
|
|
1386 (cond ((eq state 'hidden)
|
|
|
1387 ;; Indicate hidden value.
|
|
|
1388 (push (widget-create-child-and-convert
|
|
|
1389 widget 'item
|
|
|
1390 :format "%{%t%}: ..."
|
|
|
1391 :sample-face 'custom-variable-sample-face
|
|
|
1392 :tag tag
|
|
|
1393 :parent widget)
|
|
|
1394 children))
|
|
|
1395 ((eq form 'lisp)
|
|
|
1396 ;; In lisp mode edit the saved value when possible.
|
|
|
1397 (let* ((value (cond ((get symbol 'saved-value)
|
|
|
1398 (car (get symbol 'saved-value)))
|
|
|
1399 ((get symbol 'factory-value)
|
|
|
1400 (car (get symbol 'factory-value)))
|
|
|
1401 ((default-boundp symbol)
|
|
149
|
1402 (custom-quote (funcall get symbol)))
|
|
28
|
1403 (t
|
|
|
1404 (custom-quote (widget-get conv :value))))))
|
|
|
1405 (push (widget-create-child-and-convert
|
|
|
1406 widget 'sexp
|
|
|
1407 :button-face 'custom-variable-button-face
|
|
|
1408 :tag (symbol-name symbol)
|
|
|
1409 :parent widget
|
|
|
1410 :value value)
|
|
|
1411 children)))
|
|
|
1412 (t
|
|
|
1413 ;; Edit mode.
|
|
|
1414 (push (widget-create-child-and-convert
|
|
|
1415 widget type
|
|
|
1416 :tag tag
|
|
|
1417 :button-face 'custom-variable-button-face
|
|
|
1418 :sample-face 'custom-variable-sample-face
|
|
|
1419 :value value)
|
|
|
1420 children)))
|
|
|
1421 ;; Now update the state.
|
|
|
1422 (unless (eq (preceding-char) ?\n)
|
|
|
1423 (widget-insert "\n"))
|
|
|
1424 (if (eq state 'hidden)
|
|
|
1425 (widget-put widget :custom-state state)
|
|
|
1426 (custom-variable-state-set widget))
|
|
|
1427 (widget-put widget :custom-form form)
|
|
|
1428 (widget-put widget :buttons buttons)
|
|
|
1429 (widget-put widget :children children)))
|
|
|
1430
|
|
|
1431 (defun custom-variable-state-set (widget)
|
|
|
1432 "Set the state of WIDGET."
|
|
|
1433 (let* ((symbol (widget-value widget))
|
|
149
|
1434 (get (or (get symbol 'custom-get) 'default-value))
|
|
28
|
1435 (value (if (default-boundp symbol)
|
|
149
|
1436 (funcall get symbol)
|
|
28
|
1437 (widget-get widget :value)))
|
|
|
1438 tmp
|
|
|
1439 (state (cond ((setq tmp (get symbol 'customized-value))
|
|
|
1440 (if (condition-case nil
|
|
|
1441 (equal value (eval (car tmp)))
|
|
|
1442 (error nil))
|
|
|
1443 'set
|
|
|
1444 'changed))
|
|
|
1445 ((setq tmp (get symbol 'saved-value))
|
|
|
1446 (if (condition-case nil
|
|
|
1447 (equal value (eval (car tmp)))
|
|
|
1448 (error nil))
|
|
|
1449 'saved
|
|
|
1450 'changed))
|
|
|
1451 ((setq tmp (get symbol 'factory-value))
|
|
|
1452 (if (condition-case nil
|
|
|
1453 (equal value (eval (car tmp)))
|
|
|
1454 (error nil))
|
|
|
1455 'factory
|
|
|
1456 'changed))
|
|
|
1457 (t 'rogue))))
|
|
|
1458 (widget-put widget :custom-state state)))
|
|
|
1459
|
|
|
1460 (defvar custom-variable-menu
|
|
149
|
1461 '(("Hide" custom-toggle-hide
|
|
|
1462 (lambda (widget)
|
|
|
1463 (not (memq (widget-get widget :custom-state) '(modified invalid)))))
|
|
|
1464 ("Edit" custom-variable-edit
|
|
|
1465 (lambda (widget)
|
|
|
1466 (not (eq (widget-get widget :custom-form) 'edit))))
|
|
|
1467 ("Edit Lisp" custom-variable-edit-lisp
|
|
|
1468 (lambda (widget)
|
|
|
1469 (not (eq (widget-get widget :custom-form) 'lisp))))
|
|
|
1470 ("Set" custom-variable-set
|
|
|
1471 (lambda (widget)
|
|
|
1472 (eq (widget-get widget :custom-state) 'modified)))
|
|
|
1473 ("Save" custom-variable-save
|
|
|
1474 (lambda (widget)
|
|
|
1475 (memq (widget-get widget :custom-state) '(modified set changed rogue))))
|
|
|
1476 ("Reset to Current" custom-redraw
|
|
|
1477 (lambda (widget)
|
|
|
1478 (and (default-boundp (widget-value widget))
|
|
|
1479 (memq (widget-get widget :custom-state) '(modified changed)))))
|
|
|
1480 ("Reset to Saved" custom-variable-reset-saved
|
|
|
1481 (lambda (widget)
|
|
|
1482 (and (get (widget-value widget) 'saved-value)
|
|
|
1483 (memq (widget-get widget :custom-state)
|
|
|
1484 '(modified set changed rogue)))))
|
|
|
1485 ("Reset to Factory Settings" custom-variable-reset-factory
|
|
|
1486 (lambda (widget)
|
|
|
1487 (and (get (widget-value widget) 'factory-value)
|
|
|
1488 (memq (widget-get widget :custom-state)
|
|
|
1489 '(modified set changed saved rogue))))))
|
|
28
|
1490 "Alist of actions for the `custom-variable' widget.
|
|
149
|
1491 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
|
|
|
1492 the menu entry, ACTION is the function to call on the widget when the
|
|
|
1493 menu is selected, and FILTER is a predicate which takes a `custom-variable'
|
|
|
1494 widget as an argument, and returns non-nil if ACTION is valid on that
|
|
|
1495 widget. If FILTER is nil, ACTION is always valid.")
|
|
28
|
1496
|
|
|
1497 (defun custom-variable-action (widget &optional event)
|
|
|
1498 "Show the menu for `custom-variable' WIDGET.
|
|
|
1499 Optional EVENT is the location for the menu."
|
|
|
1500 (if (eq (widget-get widget :custom-state) 'hidden)
|
|
149
|
1501 (custom-toggle-hide widget)
|
|
|
1502 (unless (eq (widget-get widget :custom-state) 'modified)
|
|
|
1503 (custom-variable-state-set widget))
|
|
|
1504 (custom-redraw-magic widget)
|
|
28
|
1505 (let* ((completion-ignore-case t)
|
|
|
1506 (answer (widget-choose (custom-unlispify-tag-name
|
|
|
1507 (widget-get widget :value))
|
|
149
|
1508 (custom-menu-filter custom-variable-menu
|
|
|
1509 widget)
|
|
28
|
1510 event)))
|
|
|
1511 (if answer
|
|
|
1512 (funcall answer widget)))))
|
|
|
1513
|
|
|
1514 (defun custom-variable-edit (widget)
|
|
|
1515 "Edit value of WIDGET."
|
|
|
1516 (widget-put widget :custom-state 'unknown)
|
|
|
1517 (widget-put widget :custom-form 'edit)
|
|
|
1518 (custom-redraw widget))
|
|
|
1519
|
|
|
1520 (defun custom-variable-edit-lisp (widget)
|
|
|
1521 "Edit the lisp representation of the value of WIDGET."
|
|
|
1522 (widget-put widget :custom-state 'unknown)
|
|
|
1523 (widget-put widget :custom-form 'lisp)
|
|
|
1524 (custom-redraw widget))
|
|
|
1525
|
|
|
1526 (defun custom-variable-set (widget)
|
|
|
1527 "Set the current value for the variable being edited by WIDGET."
|
|
149
|
1528 (let* ((form (widget-get widget :custom-form))
|
|
|
1529 (state (widget-get widget :custom-state))
|
|
|
1530 (child (car (widget-get widget :children)))
|
|
|
1531 (symbol (widget-value widget))
|
|
|
1532 (set (or (get symbol 'custom-set) 'set-default))
|
|
|
1533 val)
|
|
28
|
1534 (cond ((eq state 'hidden)
|
|
|
1535 (error "Cannot set hidden variable."))
|
|
|
1536 ((setq val (widget-apply child :validate))
|
|
|
1537 (goto-char (widget-get val :from))
|
|
|
1538 (error "%s" (widget-get val :error)))
|
|
|
1539 ((eq form 'lisp)
|
|
149
|
1540 (funcall set symbol (eval (setq val (widget-value child))))
|
|
28
|
1541 (put symbol 'customized-value (list val)))
|
|
|
1542 (t
|
|
149
|
1543 (funcall set symbol (setq val (widget-value child)))
|
|
28
|
1544 (put symbol 'customized-value (list (custom-quote val)))))
|
|
|
1545 (custom-variable-state-set widget)
|
|
|
1546 (custom-redraw-magic widget)))
|
|
|
1547
|
|
|
1548 (defun custom-variable-save (widget)
|
|
|
1549 "Set the default value for the variable being edited by WIDGET."
|
|
149
|
1550 (let* ((form (widget-get widget :custom-form))
|
|
|
1551 (state (widget-get widget :custom-state))
|
|
|
1552 (child (car (widget-get widget :children)))
|
|
|
1553 (symbol (widget-value widget))
|
|
|
1554 (set (or (get symbol 'custom-set) 'set-default))
|
|
|
1555 val)
|
|
28
|
1556 (cond ((eq state 'hidden)
|
|
|
1557 (error "Cannot set hidden variable."))
|
|
|
1558 ((setq val (widget-apply child :validate))
|
|
|
1559 (goto-char (widget-get val :from))
|
|
|
1560 (error "%s" (widget-get val :error)))
|
|
|
1561 ((eq form 'lisp)
|
|
|
1562 (put symbol 'saved-value (list (widget-value child)))
|
|
149
|
1563 (funcall set symbol (eval (widget-value child))))
|
|
28
|
1564 (t
|
|
|
1565 (put symbol
|
|
|
1566 'saved-value (list (custom-quote (widget-value
|
|
|
1567 child))))
|
|
149
|
1568 (funcall set symbol (widget-value child))))
|
|
28
|
1569 (put symbol 'customized-value nil)
|
|
|
1570 (custom-save-all)
|
|
|
1571 (custom-variable-state-set widget)
|
|
|
1572 (custom-redraw-magic widget)))
|
|
|
1573
|
|
|
1574 (defun custom-variable-reset-saved (widget)
|
|
|
1575 "Restore the saved value for the variable being edited by WIDGET."
|
|
149
|
1576 (let* ((symbol (widget-value widget))
|
|
|
1577 (set (or (get symbol 'custom-set) 'set-default)))
|
|
28
|
1578 (if (get symbol 'saved-value)
|
|
|
1579 (condition-case nil
|
|
149
|
1580 (funcall set symbol (eval (car (get symbol 'saved-value))))
|
|
28
|
1581 (error nil))
|
|
|
1582 (error "No saved value for %s" symbol))
|
|
|
1583 (put symbol 'customized-value nil)
|
|
|
1584 (widget-put widget :custom-state 'unknown)
|
|
|
1585 (custom-redraw widget)))
|
|
|
1586
|
|
|
1587 (defun custom-variable-reset-factory (widget)
|
|
|
1588 "Restore the factory setting for the variable being edited by WIDGET."
|
|
149
|
1589 (let* ((symbol (widget-value widget))
|
|
|
1590 (set (or (get symbol 'custom-set) 'set-default)))
|
|
28
|
1591 (if (get symbol 'factory-value)
|
|
149
|
1592 (funcall set symbol (eval (car (get symbol 'factory-value))))
|
|
28
|
1593 (error "No factory default for %S" symbol))
|
|
|
1594 (put symbol 'customized-value nil)
|
|
|
1595 (when (get symbol 'saved-value)
|
|
|
1596 (put symbol 'saved-value nil)
|
|
|
1597 (custom-save-all))
|
|
|
1598 (widget-put widget :custom-state 'unknown)
|
|
|
1599 (custom-redraw widget)))
|
|
|
1600
|
|
|
1601 ;;; The `custom-face-edit' Widget.
|
|
|
1602
|
|
|
1603 (define-widget 'custom-face-edit 'checklist
|
|
|
1604 "Edit face attributes."
|
|
|
1605 :format "%t: %v"
|
|
|
1606 :tag "Attributes"
|
|
|
1607 :extra-offset 12
|
|
30
|
1608 :button-args '(:help-echo "Control whether this attribute have any effect.")
|
|
28
|
1609 :args (mapcar (lambda (att)
|
|
|
1610 (list 'group
|
|
|
1611 :inline t
|
|
30
|
1612 :sibling-args (widget-get (nth 1 att) :sibling-args)
|
|
28
|
1613 (list 'const :format "" :value (nth 0 att))
|
|
|
1614 (nth 1 att)))
|
|
|
1615 custom-face-attributes))
|
|
|
1616
|
|
|
1617 ;;; The `custom-display' Widget.
|
|
|
1618
|
|
|
1619 (define-widget 'custom-display 'menu-choice
|
|
|
1620 "Select a display type."
|
|
|
1621 :tag "Display"
|
|
|
1622 :value t
|
|
30
|
1623 :help-echo "Specify frames where the face attributes should be used."
|
|
28
|
1624 :args '((const :tag "all" t)
|
|
30
|
1625 (checklist
|
|
|
1626 :offset 0
|
|
|
1627 :extra-offset 9
|
|
|
1628 :args ((group :sibling-args (:help-echo "\
|
|
|
1629 Only match the specified window systems.")
|
|
|
1630 (const :format "Type: "
|
|
|
1631 type)
|
|
|
1632 (checklist :inline t
|
|
|
1633 :offset 0
|
|
|
1634 (const :format "X "
|
|
|
1635 :sibling-args (:help-echo "\
|
|
|
1636 The X11 Window System.")
|
|
|
1637 x)
|
|
|
1638 (const :format "PM "
|
|
|
1639 :sibling-args (:help-echo "\
|
|
|
1640 OS/2 Presentation Manager.")
|
|
|
1641 pm)
|
|
|
1642 (const :format "Win32 "
|
|
|
1643 :sibling-args (:help-echo "\
|
|
|
1644 Windows NT/95/97.")
|
|
|
1645 win32)
|
|
|
1646 (const :format "DOS "
|
|
|
1647 :sibling-args (:help-echo "\
|
|
|
1648 Plain MS-DOS.")
|
|
|
1649 pc)
|
|
|
1650 (const :format "TTY%n"
|
|
|
1651 :sibling-args (:help-echo "\
|
|
|
1652 Plain text terminals.")
|
|
|
1653 tty)))
|
|
|
1654 (group :sibling-args (:help-echo "\
|
|
|
1655 Only match the frames with the specified color support.")
|
|
|
1656 (const :format "Class: "
|
|
|
1657 class)
|
|
|
1658 (checklist :inline t
|
|
|
1659 :offset 0
|
|
|
1660 (const :format "Color "
|
|
|
1661 :sibling-args (:help-echo "\
|
|
|
1662 Match color frames.")
|
|
|
1663 color)
|
|
|
1664 (const :format "Grayscale "
|
|
|
1665 :sibling-args (:help-echo "\
|
|
|
1666 Match grayscale frames.")
|
|
|
1667 grayscale)
|
|
|
1668 (const :format "Monochrome%n"
|
|
|
1669 :sibling-args (:help-echo "\
|
|
|
1670 Match frames with no color support.")
|
|
|
1671 mono)))
|
|
|
1672 (group :sibling-args (:help-echo "\
|
|
|
1673 Only match frames with the specified intensity.")
|
|
|
1674 (const :format "\
|
|
|
1675 Background brightness: "
|
|
|
1676 background)
|
|
|
1677 (checklist :inline t
|
|
|
1678 :offset 0
|
|
|
1679 (const :format "Light "
|
|
|
1680 :sibling-args (:help-echo "\
|
|
|
1681 Match frames with light backgrounds.")
|
|
|
1682 light)
|
|
|
1683 (const :format "Dark\n"
|
|
|
1684 :sibling-args (:help-echo "\
|
|
|
1685 Match frames with dark backgrounds.")
|
|
|
1686 dark)))))))
|
|
28
|
1687
|
|
|
1688 ;;; The `custom-face' Widget.
|
|
|
1689
|
|
|
1690 (defface custom-face-tag-face '((t (:underline t)))
|
|
|
1691 "Face used for face tags."
|
|
124
|
1692 :group 'custom-faces)
|
|
28
|
1693
|
|
|
1694 (define-widget 'custom-face 'custom
|
|
|
1695 "Customize face."
|
|
|
1696 :format "%l%{%t%}: %s%m%h%a%v"
|
|
|
1697 :format-handler 'custom-face-format-handler
|
|
|
1698 :sample-face 'custom-face-tag-face
|
|
30
|
1699 :help-echo "Set or reset this face."
|
|
28
|
1700 :documentation-property '(lambda (face)
|
|
30
|
1701 (face-doc-string face))
|
|
28
|
1702 :value-create 'custom-face-value-create
|
|
|
1703 :action 'custom-face-action
|
|
120
|
1704 :custom-form 'selected
|
|
28
|
1705 :custom-set 'custom-face-set
|
|
|
1706 :custom-save 'custom-face-save
|
|
|
1707 :custom-reset-current 'custom-redraw
|
|
|
1708 :custom-reset-saved 'custom-face-reset-saved
|
|
|
1709 :custom-reset-factory 'custom-face-reset-factory
|
|
|
1710 :custom-menu 'custom-face-menu-create)
|
|
|
1711
|
|
|
1712 (defun custom-face-format-handler (widget escape)
|
|
|
1713 ;; We recognize extra escape sequences.
|
|
|
1714 (let (child
|
|
|
1715 (symbol (widget-get widget :value)))
|
|
|
1716 (cond ((eq escape ?s)
|
|
|
1717 (and (string-match "XEmacs" emacs-version)
|
|
|
1718 ;; XEmacs cannot display initialized faces.
|
|
|
1719 (not (custom-facep symbol))
|
|
|
1720 (copy-face 'custom-face-empty symbol))
|
|
|
1721 (setq child (widget-create-child-and-convert
|
|
|
1722 widget 'item
|
|
|
1723 :format "(%{%t%})\n"
|
|
|
1724 :sample-face symbol
|
|
|
1725 :tag "sample")))
|
|
|
1726 (t
|
|
|
1727 (custom-format-handler widget escape)))
|
|
|
1728 (when child
|
|
|
1729 (widget-put widget
|
|
|
1730 :buttons (cons child (widget-get widget :buttons))))))
|
|
|
1731
|
|
120
|
1732 (define-widget 'custom-face-all 'editable-list
|
|
|
1733 "An editable list of display specifications and attributes."
|
|
|
1734 :entry-format "%i %d %v"
|
|
|
1735 :insert-button-args '(:help-echo "Insert new display specification here.")
|
|
|
1736 :append-button-args '(:help-echo "Append new display specification here.")
|
|
|
1737 :delete-button-args '(:help-echo "Delete this display specification.")
|
|
|
1738 :args '((group :format "%v" custom-display custom-face-edit)))
|
|
|
1739
|
|
|
1740 (defconst custom-face-all (widget-convert 'custom-face-all)
|
|
|
1741 "Converted version of the `custom-face-all' widget.")
|
|
|
1742
|
|
|
1743 (define-widget 'custom-display-unselected 'item
|
|
|
1744 "A display specification that doesn't match the selected display."
|
|
|
1745 :match 'custom-display-unselected-match)
|
|
|
1746
|
|
|
1747 (defun custom-display-unselected-match (widget value)
|
|
|
1748 "Non-nil if VALUE is an unselected display specification."
|
|
149
|
1749 (not (face-spec-set-match-display value (selected-frame))))
|
|
120
|
1750
|
|
|
1751 (define-widget 'custom-face-selected 'group
|
|
|
1752 "Edit the attributes of the selected display in a face specification."
|
|
|
1753 :args '((repeat :format ""
|
|
|
1754 :inline t
|
|
|
1755 (group custom-display-unselected sexp))
|
|
|
1756 (group (sexp :format "") custom-face-edit)
|
|
|
1757 (repeat :format ""
|
|
|
1758 :inline t
|
|
|
1759 sexp)))
|
|
|
1760
|
|
|
1761 (defconst custom-face-selected (widget-convert 'custom-face-selected)
|
|
|
1762 "Converted version of the `custom-face-selected' widget.")
|
|
|
1763
|
|
28
|
1764 (defun custom-face-value-create (widget)
|
|
|
1765 ;; Create a list of the display specifications.
|
|
|
1766 (unless (eq (preceding-char) ?\n)
|
|
|
1767 (insert "\n"))
|
|
|
1768 (when (not (eq (widget-get widget :custom-state) 'hidden))
|
|
120
|
1769 (message "Creating face editor...")
|
|
28
|
1770 (custom-load-widget widget)
|
|
|
1771 (let* ((symbol (widget-value widget))
|
|
120
|
1772 (spec (or (get symbol 'saved-face)
|
|
149
|
1773 (get symbol 'face-defface-spec)
|
|
120
|
1774 ;; Attempt to construct it.
|
|
|
1775 (list (list t (custom-face-attributes-get
|
|
|
1776 symbol (selected-frame))))))
|
|
|
1777 (form (widget-get widget :custom-form))
|
|
|
1778 (indent (widget-get widget :indent))
|
|
28
|
1779 (edit (widget-create-child-and-convert
|
|
120
|
1780 widget
|
|
|
1781 (cond ((and (eq form 'selected)
|
|
|
1782 (widget-apply custom-face-selected :match spec))
|
|
|
1783 (when indent (insert-char ?\ indent))
|
|
|
1784 'custom-face-selected)
|
|
|
1785 ((and (not (eq form 'lisp))
|
|
|
1786 (widget-apply custom-face-all :match spec))
|
|
|
1787 'custom-face-all)
|
|
|
1788 (t
|
|
|
1789 (when indent (insert-char ?\ indent))
|
|
|
1790 'sexp))
|
|
|
1791 :value spec)))
|
|
28
|
1792 (custom-face-state-set widget)
|
|
120
|
1793 (widget-put widget :children (list edit)))
|
|
|
1794 (message "Creating face editor...done")))
|
|
28
|
1795
|
|
|
1796 (defvar custom-face-menu
|
|
149
|
1797 '(("Hide" custom-toggle-hide
|
|
|
1798 (lambda (widget)
|
|
|
1799 (not (memq (widget-get widget :custom-state) '(modified invalid)))))
|
|
|
1800 ("Edit Selected" custom-face-edit-selected
|
|
|
1801 (lambda (widget)
|
|
|
1802 (not (eq (widget-get widget :custom-form) 'selected))))
|
|
|
1803 ("Edit All" custom-face-edit-all
|
|
|
1804 (lambda (widget)
|
|
|
1805 (not (eq (widget-get widget :custom-form) 'all))))
|
|
|
1806 ("Edit Lisp" custom-face-edit-lisp
|
|
|
1807 (lambda (widget)
|
|
|
1808 (not (eq (widget-get widget :custom-form) 'lisp))))
|
|
|
1809 ("Set" custom-face-set)
|
|
|
1810 ("Save" custom-face-save)
|
|
|
1811 ("Reset to Saved" custom-face-reset-saved
|
|
|
1812 (lambda (widget)
|
|
|
1813 (get (widget-value widget) 'saved-face)))
|
|
|
1814 ("Reset to Factory Setting" custom-face-reset-factory
|
|
|
1815 (lambda (widget)
|
|
|
1816 (get (widget-value widget) 'face-defface-spec))))
|
|
28
|
1817 "Alist of actions for the `custom-face' widget.
|
|
149
|
1818 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
|
|
|
1819 the menu entry, ACTION is the function to call on the widget when the
|
|
|
1820 menu is selected, and FILTER is a predicate which takes a `custom-face'
|
|
|
1821 widget as an argument, and returns non-nil if ACTION is valid on that
|
|
|
1822 widget. If FILTER is nil, ACTION is always valid.")
|
|
28
|
1823
|
|
120
|
1824 (defun custom-face-edit-selected (widget)
|
|
|
1825 "Edit selected attributes of the value of WIDGET."
|
|
|
1826 (widget-put widget :custom-state 'unknown)
|
|
|
1827 (widget-put widget :custom-form 'selected)
|
|
|
1828 (custom-redraw widget))
|
|
|
1829
|
|
|
1830 (defun custom-face-edit-all (widget)
|
|
|
1831 "Edit all attributes of the value of WIDGET."
|
|
|
1832 (widget-put widget :custom-state 'unknown)
|
|
|
1833 (widget-put widget :custom-form 'all)
|
|
|
1834 (custom-redraw widget))
|
|
|
1835
|
|
|
1836 (defun custom-face-edit-lisp (widget)
|
|
|
1837 "Edit the lisp representation of the value of WIDGET."
|
|
|
1838 (widget-put widget :custom-state 'unknown)
|
|
|
1839 (widget-put widget :custom-form 'lisp)
|
|
|
1840 (custom-redraw widget))
|
|
|
1841
|
|
28
|
1842 (defun custom-face-state-set (widget)
|
|
|
1843 "Set the state of WIDGET."
|
|
|
1844 (let ((symbol (widget-value widget)))
|
|
|
1845 (widget-put widget :custom-state (cond ((get symbol 'customized-face)
|
|
|
1846 'set)
|
|
|
1847 ((get symbol 'saved-face)
|
|
|
1848 'saved)
|
|
149
|
1849 ((get symbol 'face-defface-spec)
|
|
28
|
1850 'factory)
|
|
|
1851 (t
|
|
|
1852 'rogue)))))
|
|
|
1853
|
|
|
1854 (defun custom-face-action (widget &optional event)
|
|
|
1855 "Show the menu for `custom-face' WIDGET.
|
|
|
1856 Optional EVENT is the location for the menu."
|
|
|
1857 (if (eq (widget-get widget :custom-state) 'hidden)
|
|
149
|
1858 (custom-toggle-hide widget)
|
|
28
|
1859 (let* ((completion-ignore-case t)
|
|
|
1860 (symbol (widget-get widget :value))
|
|
|
1861 (answer (widget-choose (custom-unlispify-tag-name symbol)
|
|
149
|
1862 (custom-menu-filter custom-face-menu
|
|
|
1863 widget)
|
|
|
1864 event)))
|
|
28
|
1865 (if answer
|
|
|
1866 (funcall answer widget)))))
|
|
|
1867
|
|
|
1868 (defun custom-face-set (widget)
|
|
|
1869 "Make the face attributes in WIDGET take effect."
|
|
|
1870 (let* ((symbol (widget-value widget))
|
|
|
1871 (child (car (widget-get widget :children)))
|
|
|
1872 (value (widget-value child)))
|
|
|
1873 (put symbol 'customized-face value)
|
|
|
1874 (custom-face-display-set symbol value)
|
|
|
1875 (custom-face-state-set widget)
|
|
|
1876 (custom-redraw-magic widget)))
|
|
|
1877
|
|
|
1878 (defun custom-face-save (widget)
|
|
|
1879 "Make the face attributes in WIDGET default."
|
|
|
1880 (let* ((symbol (widget-value widget))
|
|
|
1881 (child (car (widget-get widget :children)))
|
|
|
1882 (value (widget-value child)))
|
|
|
1883 (custom-face-display-set symbol value)
|
|
|
1884 (put symbol 'saved-face value)
|
|
|
1885 (put symbol 'customized-face nil)
|
|
|
1886 (custom-face-state-set widget)
|
|
|
1887 (custom-redraw-magic widget)))
|
|
|
1888
|
|
|
1889 (defun custom-face-reset-saved (widget)
|
|
|
1890 "Restore WIDGET to the face's default attributes."
|
|
|
1891 (let* ((symbol (widget-value widget))
|
|
|
1892 (child (car (widget-get widget :children)))
|
|
|
1893 (value (get symbol 'saved-face)))
|
|
|
1894 (unless value
|
|
|
1895 (error "No saved value for this face"))
|
|
|
1896 (put symbol 'customized-face nil)
|
|
|
1897 (custom-face-display-set symbol value)
|
|
|
1898 (widget-value-set child value)
|
|
|
1899 (custom-face-state-set widget)
|
|
|
1900 (custom-redraw-magic widget)))
|
|
|
1901
|
|
|
1902 (defun custom-face-reset-factory (widget)
|
|
|
1903 "Restore WIDGET to the face's factory settings."
|
|
|
1904 (let* ((symbol (widget-value widget))
|
|
|
1905 (child (car (widget-get widget :children)))
|
|
149
|
1906 (value (get symbol 'face-defface-spec)))
|
|
28
|
1907 (unless value
|
|
|
1908 (error "No factory default for this face"))
|
|
|
1909 (put symbol 'customized-face nil)
|
|
|
1910 (when (get symbol 'saved-face)
|
|
|
1911 (put symbol 'saved-face nil)
|
|
|
1912 (custom-save-all))
|
|
|
1913 (custom-face-display-set symbol value)
|
|
|
1914 (widget-value-set child value)
|
|
|
1915 (custom-face-state-set widget)
|
|
|
1916 (custom-redraw-magic widget)))
|
|
|
1917
|
|
|
1918 ;;; The `face' Widget.
|
|
|
1919
|
|
|
1920 (define-widget 'face 'default
|
|
|
1921 "Select and customize a face."
|
|
149
|
1922 :convert-widget 'widget-value-convert-widget
|
|
28
|
1923 :format "%[%t%]: %v"
|
|
|
1924 :tag "Face"
|
|
|
1925 :value 'default
|
|
|
1926 :value-create 'widget-face-value-create
|
|
|
1927 :value-delete 'widget-face-value-delete
|
|
149
|
1928 :value-get 'widget-value-value-get
|
|
|
1929 :validate 'widget-children-validate
|
|
28
|
1930 :action 'widget-face-action
|
|
|
1931 :match '(lambda (widget value) (symbolp value)))
|
|
|
1932
|
|
|
1933 (defun widget-face-value-create (widget)
|
|
|
1934 ;; Create a `custom-face' child.
|
|
|
1935 (let* ((symbol (widget-value widget))
|
|
|
1936 (child (widget-create-child-and-convert
|
|
|
1937 widget 'custom-face
|
|
|
1938 :format "%t %s%m%h%v"
|
|
|
1939 :custom-level nil
|
|
|
1940 :value symbol)))
|
|
|
1941 (custom-magic-reset child)
|
|
|
1942 (setq custom-options (cons child custom-options))
|
|
|
1943 (widget-put widget :children (list child))))
|
|
|
1944
|
|
|
1945 (defun widget-face-value-delete (widget)
|
|
|
1946 ;; Remove the child from the options.
|
|
|
1947 (let ((child (car (widget-get widget :children))))
|
|
|
1948 (setq custom-options (delq child custom-options))
|
|
|
1949 (widget-children-value-delete widget)))
|
|
|
1950
|
|
|
1951 (defvar face-history nil
|
|
|
1952 "History of entered face names.")
|
|
|
1953
|
|
|
1954 (defun widget-face-action (widget &optional event)
|
|
|
1955 "Prompt for a face."
|
|
|
1956 (let ((answer (completing-read "Face: "
|
|
|
1957 (mapcar (lambda (face)
|
|
|
1958 (list (symbol-name face)))
|
|
|
1959 (face-list))
|
|
|
1960 nil nil nil
|
|
|
1961 'face-history)))
|
|
|
1962 (unless (zerop (length answer))
|
|
|
1963 (widget-value-set widget (intern answer))
|
|
|
1964 (widget-apply widget :notify widget event)
|
|
|
1965 (widget-setup))))
|
|
|
1966
|
|
|
1967 ;;; The `hook' Widget.
|
|
|
1968
|
|
|
1969 (define-widget 'hook 'list
|
|
|
1970 "A emacs lisp hook"
|
|
|
1971 :convert-widget 'custom-hook-convert-widget
|
|
|
1972 :tag "Hook")
|
|
|
1973
|
|
|
1974 (defun custom-hook-convert-widget (widget)
|
|
|
1975 ;; Handle `:custom-options'.
|
|
|
1976 (let* ((options (widget-get widget :options))
|
|
|
1977 (other `(editable-list :inline t
|
|
|
1978 :entry-format "%i %d%v"
|
|
|
1979 (function :format " %v")))
|
|
|
1980 (args (if options
|
|
|
1981 (list `(checklist :inline t
|
|
|
1982 ,@(mapcar (lambda (entry)
|
|
|
1983 `(function-item ,entry))
|
|
|
1984 options))
|
|
|
1985 other)
|
|
|
1986 (list other))))
|
|
|
1987 (widget-put widget :args args)
|
|
|
1988 widget))
|
|
|
1989
|
|
|
1990 ;;; The `custom-group' Widget.
|
|
|
1991
|
|
|
1992 (defcustom custom-group-tag-faces '(custom-group-tag-face-1)
|
|
|
1993 ;; In XEmacs, this ought to play games with font size.
|
|
|
1994 "Face used for group tags.
|
|
|
1995 The first member is used for level 1 groups, the second for level 2,
|
|
|
1996 and so forth. The remaining group tags are shown with
|
|
|
1997 `custom-group-tag-face'."
|
|
|
1998 :type '(repeat face)
|
|
124
|
1999 :group 'custom-faces)
|
|
28
|
2000
|
|
|
2001 (defface custom-group-tag-face-1 '((((class color)
|
|
118
|
2002 (background dark))
|
|
|
2003 (:foreground "pink" :underline t))
|
|
|
2004 (((class color)
|
|
|
2005 (background light))
|
|
|
2006 (:foreground "red" :underline t))
|
|
|
2007 (t (:underline t)))
|
|
28
|
2008 "Face used for group tags.")
|
|
|
2009
|
|
|
2010 (defface custom-group-tag-face '((((class color)
|
|
|
2011 (background dark))
|
|
|
2012 (:foreground "light blue" :underline t))
|
|
|
2013 (((class color)
|
|
|
2014 (background light))
|
|
|
2015 (:foreground "blue" :underline t))
|
|
|
2016 (t (:underline t)))
|
|
|
2017 "Face used for low level group tags."
|
|
124
|
2018 :group 'custom-faces)
|
|
28
|
2019
|
|
|
2020 (define-widget 'custom-group 'custom
|
|
|
2021 "Customize group."
|
|
|
2022 :format "%l%{%t%}:%L\n%m%h%a%v"
|
|
|
2023 :sample-face-get 'custom-group-sample-face-get
|
|
|
2024 :documentation-property 'group-documentation
|
|
30
|
2025 :help-echo "Set or reset all members of this group."
|
|
28
|
2026 :value-create 'custom-group-value-create
|
|
|
2027 :action 'custom-group-action
|
|
|
2028 :custom-set 'custom-group-set
|
|
|
2029 :custom-save 'custom-group-save
|
|
|
2030 :custom-reset-current 'custom-group-reset-current
|
|
|
2031 :custom-reset-saved 'custom-group-reset-saved
|
|
|
2032 :custom-reset-factory 'custom-group-reset-factory
|
|
|
2033 :custom-menu 'custom-group-menu-create)
|
|
|
2034
|
|
|
2035 (defun custom-group-sample-face-get (widget)
|
|
|
2036 ;; Use :sample-face.
|
|
|
2037 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
|
|
|
2038 'custom-group-tag-face))
|
|
|
2039
|
|
|
2040 (defun custom-group-value-create (widget)
|
|
|
2041 (let ((state (widget-get widget :custom-state)))
|
|
|
2042 (unless (eq state 'hidden)
|
|
120
|
2043 (message "Creating group...")
|
|
28
|
2044 (custom-load-widget widget)
|
|
|
2045 (let* ((level (widget-get widget :custom-level))
|
|
|
2046 (symbol (widget-value widget))
|
|
|
2047 (members (get symbol 'custom-group))
|
|
|
2048 (prefixes (widget-get widget :custom-prefixes))
|
|
|
2049 (custom-prefix-list (custom-prefix-add symbol prefixes))
|
|
120
|
2050 (length (length members))
|
|
|
2051 (count 0)
|
|
28
|
2052 (children (mapcar (lambda (entry)
|
|
|
2053 (widget-insert "\n")
|
|
120
|
2054 (message "Creating group members... %2d%%"
|
|
|
2055 (/ (* 100.0 count) length))
|
|
|
2056 (setq count (1+ count))
|
|
28
|
2057 (prog1
|
|
|
2058 (widget-create-child-and-convert
|
|
|
2059 widget (nth 1 entry)
|
|
|
2060 :group widget
|
|
|
2061 :tag (custom-unlispify-tag-name
|
|
|
2062 (nth 0 entry))
|
|
|
2063 :custom-prefixes custom-prefix-list
|
|
|
2064 :custom-level (1+ level)
|
|
|
2065 :value (nth 0 entry))
|
|
|
2066 (unless (eq (preceding-char) ?\n)
|
|
|
2067 (widget-insert "\n"))))
|
|
|
2068 members)))
|
|
120
|
2069 (message "Creating group magic...")
|
|
28
|
2070 (mapcar 'custom-magic-reset children)
|
|
120
|
2071 (message "Creating group state...")
|
|
28
|
2072 (widget-put widget :children children)
|
|
120
|
2073 (custom-group-state-update widget)
|
|
|
2074 (message "Creating group... done")))))
|
|
28
|
2075
|
|
|
2076 (defvar custom-group-menu
|
|
149
|
2077 '(("Hide" custom-toggle-hide
|
|
|
2078 (lambda (widget)
|
|
|
2079 (not (memq (widget-get widget :custom-state) '(modified invalid)))))
|
|
|
2080 ("Set" custom-group-set
|
|
|
2081 (lambda (widget)
|
|
|
2082 (eq (widget-get widget :custom-state) 'modified)))
|
|
|
2083 ("Save" custom-group-save
|
|
|
2084 (lambda (widget)
|
|
|
2085 (memq (widget-get widget :custom-state) '(modified set))))
|
|
|
2086 ("Reset to Current" custom-group-reset-current
|
|
|
2087 (lambda (widget)
|
|
|
2088 (memq (widget-get widget :custom-state) '(modified))))
|
|
|
2089 ("Reset to Saved" custom-group-reset-saved
|
|
|
2090 (lambda (widget)
|
|
|
2091 (memq (widget-get widget :custom-state) '(modified set))))
|
|
|
2092 ("Reset to Factory" custom-group-reset-factory
|
|
|
2093 (lambda (widget)
|
|
|
2094 (memq (widget-get widget :custom-state) '(modified set saved)))))
|
|
28
|
2095 "Alist of actions for the `custom-group' widget.
|
|
149
|
2096 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
|
|
|
2097 the menu entry, ACTION is the function to call on the widget when the
|
|
|
2098 menu is selected, and FILTER is a predicate which takes a `custom-group'
|
|
|
2099 widget as an argument, and returns non-nil if ACTION is valid on that
|
|
|
2100 widget. If FILTER is nil, ACTION is always valid.")
|
|
28
|
2101
|
|
|
2102 (defun custom-group-action (widget &optional event)
|
|
|
2103 "Show the menu for `custom-group' WIDGET.
|
|
|
2104 Optional EVENT is the location for the menu."
|
|
|
2105 (if (eq (widget-get widget :custom-state) 'hidden)
|
|
149
|
2106 (custom-toggle-hide widget)
|
|
28
|
2107 (let* ((completion-ignore-case t)
|
|
|
2108 (answer (widget-choose (custom-unlispify-tag-name
|
|
|
2109 (widget-get widget :value))
|
|
149
|
2110 (custom-menu-filter custom-group-menu
|
|
|
2111 widget)
|
|
28
|
2112 event)))
|
|
|
2113 (if answer
|
|
|
2114 (funcall answer widget)))))
|
|
|
2115
|
|
|
2116 (defun custom-group-set (widget)
|
|
|
2117 "Set changes in all modified group members."
|
|
|
2118 (let ((children (widget-get widget :children)))
|
|
|
2119 (mapcar (lambda (child)
|
|
|
2120 (when (eq (widget-get child :custom-state) 'modified)
|
|
|
2121 (widget-apply child :custom-set)))
|
|
|
2122 children )))
|
|
|
2123
|
|
|
2124 (defun custom-group-save (widget)
|
|
|
2125 "Save all modified group members."
|
|
|
2126 (let ((children (widget-get widget :children)))
|
|
|
2127 (mapcar (lambda (child)
|
|
|
2128 (when (memq (widget-get child :custom-state) '(modified set))
|
|
|
2129 (widget-apply child :custom-save)))
|
|
|
2130 children )))
|
|
|
2131
|
|
|
2132 (defun custom-group-reset-current (widget)
|
|
|
2133 "Reset all modified group members."
|
|
|
2134 (let ((children (widget-get widget :children)))
|
|
|
2135 (mapcar (lambda (child)
|
|
|
2136 (when (eq (widget-get child :custom-state) 'modified)
|
|
|
2137 (widget-apply child :custom-reset-current)))
|
|
|
2138 children )))
|
|
|
2139
|
|
|
2140 (defun custom-group-reset-saved (widget)
|
|
|
2141 "Reset all modified or set group members."
|
|
|
2142 (let ((children (widget-get widget :children)))
|
|
|
2143 (mapcar (lambda (child)
|
|
|
2144 (when (memq (widget-get child :custom-state) '(modified set))
|
|
|
2145 (widget-apply child :custom-reset-saved)))
|
|
|
2146 children )))
|
|
|
2147
|
|
|
2148 (defun custom-group-reset-factory (widget)
|
|
|
2149 "Reset all modified, set, or saved group members."
|
|
|
2150 (let ((children (widget-get widget :children)))
|
|
|
2151 (mapcar (lambda (child)
|
|
|
2152 (when (memq (widget-get child :custom-state)
|
|
|
2153 '(modified set saved))
|
|
|
2154 (widget-apply child :custom-reset-factory)))
|
|
|
2155 children )))
|
|
|
2156
|
|
|
2157 (defun custom-group-state-update (widget)
|
|
|
2158 "Update magic."
|
|
|
2159 (unless (eq (widget-get widget :custom-state) 'hidden)
|
|
|
2160 (let* ((children (widget-get widget :children))
|
|
|
2161 (states (mapcar (lambda (child)
|
|
|
2162 (widget-get child :custom-state))
|
|
|
2163 children))
|
|
|
2164 (magics custom-magic-alist)
|
|
|
2165 (found 'factory))
|
|
|
2166 (while magics
|
|
|
2167 (let ((magic (car (car magics))))
|
|
|
2168 (if (and (not (eq magic 'hidden))
|
|
|
2169 (memq magic states))
|
|
|
2170 (setq found magic
|
|
|
2171 magics nil)
|
|
|
2172 (setq magics (cdr magics)))))
|
|
|
2173 (widget-put widget :custom-state found)))
|
|
|
2174 (custom-magic-reset widget))
|
|
|
2175
|
|
|
2176 ;;; The `custom-save-all' Function.
|
|
|
2177
|
|
|
2178 (defcustom custom-file "~/.emacs"
|
|
|
2179 "File used for storing customization information.
|
|
|
2180 If you change this from the default \"~/.emacs\" you need to
|
|
|
2181 explicitly load that file for the settings to take effect."
|
|
|
2182 :type 'file
|
|
|
2183 :group 'customize)
|
|
|
2184
|
|
|
2185 (defun custom-save-delete (symbol)
|
|
|
2186 "Delete the call to SYMBOL form `custom-file'.
|
|
|
2187 Leave point at the location of the call, or after the last expression."
|
|
|
2188 (set-buffer (find-file-noselect custom-file))
|
|
|
2189 (goto-char (point-min))
|
|
|
2190 (catch 'found
|
|
|
2191 (while t
|
|
|
2192 (let ((sexp (condition-case nil
|
|
|
2193 (read (current-buffer))
|
|
|
2194 (end-of-file (throw 'found nil)))))
|
|
|
2195 (when (and (listp sexp)
|
|
|
2196 (eq (car sexp) symbol))
|
|
|
2197 (delete-region (save-excursion
|
|
|
2198 (backward-sexp)
|
|
|
2199 (point))
|
|
|
2200 (point))
|
|
|
2201 (throw 'found nil))))))
|
|
|
2202
|
|
|
2203 (defun custom-save-variables ()
|
|
|
2204 "Save all customized variables in `custom-file'."
|
|
|
2205 (save-excursion
|
|
|
2206 (custom-save-delete 'custom-set-variables)
|
|
|
2207 (let ((standard-output (current-buffer)))
|
|
|
2208 (unless (bolp)
|
|
|
2209 (princ "\n"))
|
|
|
2210 (princ "(custom-set-variables")
|
|
|
2211 (mapatoms (lambda (symbol)
|
|
149
|
2212 (let ((value (get symbol 'saved-value))
|
|
|
2213 (requests (get symbol 'custom-requests))
|
|
|
2214 (now (not (or (get symbol 'factory-value)
|
|
|
2215 (and (not (boundp symbol))
|
|
|
2216 (not (get symbol 'force-value)))))))
|
|
28
|
2217 (when value
|
|
|
2218 (princ "\n '(")
|
|
|
2219 (princ symbol)
|
|
|
2220 (princ " ")
|
|
|
2221 (prin1 (car value))
|
|
149
|
2222 (cond (requests
|
|
|
2223 (if now
|
|
|
2224 (princ " t ")
|
|
|
2225 (princ " nil "))
|
|
|
2226 (prin1 requests)
|
|
|
2227 (princ ")"))
|
|
|
2228 (now
|
|
|
2229 (princ " t)"))
|
|
|
2230 (t
|
|
|
2231 (princ ")")))))))
|
|
28
|
2232 (princ ")")
|
|
120
|
2233 (unless (looking-at "\n")
|
|
28
|
2234 (princ "\n")))))
|
|
|
2235
|
|
|
2236 (defun custom-save-faces ()
|
|
|
2237 "Save all customized faces in `custom-file'."
|
|
|
2238 (save-excursion
|
|
|
2239 (custom-save-delete 'custom-set-faces)
|
|
|
2240 (let ((standard-output (current-buffer)))
|
|
|
2241 (unless (bolp)
|
|
|
2242 (princ "\n"))
|
|
|
2243 (princ "(custom-set-faces")
|
|
120
|
2244 (let ((value (get 'default 'saved-face)))
|
|
|
2245 ;; The default face must be first, since it affects the others.
|
|
|
2246 (when value
|
|
|
2247 (princ "\n '(default ")
|
|
|
2248 (prin1 value)
|
|
149
|
2249 (if (or (get 'default 'face-defface-spec)
|
|
120
|
2250 (and (not (custom-facep 'default))
|
|
|
2251 (not (get 'default 'force-face))))
|
|
|
2252 (princ ")")
|
|
|
2253 (princ " t)"))))
|
|
28
|
2254 (mapatoms (lambda (symbol)
|
|
|
2255 (let ((value (get symbol 'saved-face)))
|
|
120
|
2256 (when (and (not (eq symbol 'default))
|
|
|
2257 ;; Don't print default face here.
|
|
|
2258 value)
|
|
28
|
2259 (princ "\n '(")
|
|
|
2260 (princ symbol)
|
|
|
2261 (princ " ")
|
|
|
2262 (prin1 value)
|
|
149
|
2263 (if (or (get symbol 'face-defface-spec)
|
|
28
|
2264 (and (not (custom-facep symbol))
|
|
|
2265 (not (get symbol 'force-face))))
|
|
|
2266 (princ ")")
|
|
|
2267 (princ " t)"))))))
|
|
|
2268 (princ ")")
|
|
120
|
2269 (unless (looking-at "\n")
|
|
28
|
2270 (princ "\n")))))
|
|
|
2271
|
|
116
|
2272 ;;;###autoload
|
|
149
|
2273 (defun custom-save-customized ()
|
|
|
2274 "Save all user options which have been set in this session."
|
|
|
2275 (interactive)
|
|
|
2276 (mapatoms (lambda (symbol)
|
|
|
2277 (let ((face (get symbol 'customized-face))
|
|
|
2278 (value (get symbol 'customized-value)))
|
|
|
2279 (when face
|
|
|
2280 (put symbol 'saved-face face)
|
|
|
2281 (put symbol 'customized-face nil))
|
|
|
2282 (when value
|
|
|
2283 (put symbol 'saved-value value)
|
|
|
2284 (put symbol 'customized-value nil)))))
|
|
|
2285 ;; We really should update all custom buffers here.
|
|
|
2286 (custom-save-all))
|
|
|
2287
|
|
|
2288 ;;;###autoload
|
|
28
|
2289 (defun custom-save-all ()
|
|
|
2290 "Save all customizations in `custom-file'."
|
|
|
2291 (custom-save-variables)
|
|
|
2292 (custom-save-faces)
|
|
|
2293 (save-excursion
|
|
|
2294 (set-buffer (find-file-noselect custom-file))
|
|
|
2295 (save-buffer)))
|
|
|
2296
|
|
|
2297 ;;; The Customize Menu.
|
|
|
2298
|
|
120
|
2299 ;;; Menu support
|
|
|
2300
|
|
|
2301 (unless (string-match "XEmacs" emacs-version)
|
|
|
2302 (defconst custom-help-menu '("Customize"
|
|
|
2303 ["Update menu..." custom-menu-update t]
|
|
|
2304 ["Group..." customize t]
|
|
|
2305 ["Variable..." customize-variable t]
|
|
|
2306 ["Face..." customize-face t]
|
|
|
2307 ["Saved..." customize-customized t]
|
|
|
2308 ["Apropos..." customize-apropos t])
|
|
|
2309 ;; This menu should be identical to the one defined in `menu-bar.el'.
|
|
|
2310 "Customize menu")
|
|
|
2311
|
|
|
2312 (defun custom-menu-reset ()
|
|
|
2313 "Reset customize menu."
|
|
|
2314 (remove-hook 'custom-define-hook 'custom-menu-reset)
|
|
|
2315 (define-key global-map [menu-bar help-menu customize-menu]
|
|
|
2316 (cons (car custom-help-menu)
|
|
|
2317 (easy-menu-create-keymaps (car custom-help-menu)
|
|
|
2318 (cdr custom-help-menu)))))
|
|
|
2319
|
|
|
2320 (defun custom-menu-update (event)
|
|
|
2321 "Update customize menu."
|
|
|
2322 (interactive "e")
|
|
|
2323 (add-hook 'custom-define-hook 'custom-menu-reset)
|
|
|
2324 (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
|
|
|
2325 (menu `(,(car custom-help-menu)
|
|
|
2326 ,emacs
|
|
|
2327 ,@(cdr (cdr custom-help-menu)))))
|
|
|
2328 (let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
|
|
|
2329 (define-key global-map [menu-bar help-menu customize-menu]
|
|
|
2330 (cons (car menu) map)))))
|
|
|
2331
|
|
|
2332 (defcustom custom-menu-nesting 2
|
|
|
2333 "Maximum nesting in custom menus."
|
|
|
2334 :type 'integer
|
|
|
2335 :group 'customize))
|
|
28
|
2336
|
|
|
2337 (defun custom-face-menu-create (widget symbol)
|
|
|
2338 "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
|
|
|
2339 (vector (custom-unlispify-menu-entry symbol)
|
|
149
|
2340 `(customize-face ',symbol)
|
|
28
|
2341 t))
|
|
|
2342
|
|
|
2343 (defun custom-variable-menu-create (widget symbol)
|
|
|
2344 "Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
|
|
|
2345 (let ((type (get symbol 'custom-type)))
|
|
|
2346 (unless (listp type)
|
|
|
2347 (setq type (list type)))
|
|
|
2348 (if (and type (widget-get type :custom-menu))
|
|
|
2349 (widget-apply type :custom-menu symbol)
|
|
|
2350 (vector (custom-unlispify-menu-entry symbol)
|
|
149
|
2351 `(customize-variable ',symbol)
|
|
28
|
2352 t))))
|
|
|
2353
|
|
120
|
2354 ;; Add checkboxes to boolean variable entries.
|
|
28
|
2355 (widget-put (get 'boolean 'widget-type)
|
|
|
2356 :custom-menu (lambda (widget symbol)
|
|
|
2357 (vector (custom-unlispify-menu-entry symbol)
|
|
149
|
2358 `(customize-variable ',symbol)
|
|
28
|
2359 ':style 'toggle
|
|
|
2360 ':selected symbol)))
|
|
|
2361
|
|
34
|
2362 (if (string-match "XEmacs" emacs-version)
|
|
|
2363 ;; XEmacs can create menus dynamically.
|
|
|
2364 (defun custom-group-menu-create (widget symbol)
|
|
|
2365 "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
|
|
|
2366 `( ,(custom-unlispify-menu-entry symbol t)
|
|
36
|
2367 :filter (lambda (&rest junk)
|
|
|
2368 (cdr (custom-menu-create ',symbol)))))
|
|
34
|
2369 ;; But emacs can't.
|
|
|
2370 (defun custom-group-menu-create (widget symbol)
|
|
|
2371 "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
|
|
|
2372 ;; Limit the nesting.
|
|
|
2373 (let ((custom-menu-nesting (1- custom-menu-nesting)))
|
|
|
2374 (custom-menu-create symbol))))
|
|
28
|
2375
|
|
120
|
2376 ;;;###autoload
|
|
124
|
2377 (defun custom-menu-create (symbol)
|
|
28
|
2378 "Create menu for customization group SYMBOL.
|
|
|
2379 The menu is in a format applicable to `easy-menu-define'."
|
|
124
|
2380 (let* ((item (vector (custom-unlispify-menu-entry symbol)
|
|
149
|
2381 `(customize ',symbol)
|
|
124
|
2382 t)))
|
|
120
|
2383 (if (and (or (not (boundp 'custom-menu-nesting))
|
|
|
2384 (>= custom-menu-nesting 0))
|
|
28
|
2385 (< (length (get symbol 'custom-group)) widget-menu-max-size))
|
|
34
|
2386 (let ((custom-prefix-list (custom-prefix-add symbol
|
|
28
|
2387 custom-prefix-list)))
|
|
|
2388 (custom-load-symbol symbol)
|
|
|
2389 `(,(custom-unlispify-menu-entry symbol t)
|
|
|
2390 ,item
|
|
|
2391 "--"
|
|
|
2392 ,@(mapcar (lambda (entry)
|
|
|
2393 (widget-apply (if (listp (nth 1 entry))
|
|
|
2394 (nth 1 entry)
|
|
|
2395 (list (nth 1 entry)))
|
|
|
2396 :custom-menu (nth 0 entry)))
|
|
|
2397 (get symbol 'custom-group))))
|
|
|
2398 item)))
|
|
|
2399
|
|
124
|
2400 ;;;###autoload
|
|
|
2401 (defun customize-menu-create (symbol &optional name)
|
|
|
2402 "Return a customize menu for customization group SYMBOL.
|
|
|
2403 If optional NAME is given, use that as the name of the menu.
|
|
|
2404 Otherwise the menu will be named `Customize'.
|
|
|
2405 The format is suitable for use with `easy-menu-define'."
|
|
|
2406 (unless name
|
|
|
2407 (setq name "Customize"))
|
|
|
2408 (if (string-match "XEmacs" emacs-version)
|
|
|
2409 ;; We can delay it under XEmacs.
|
|
|
2410 `(,name
|
|
|
2411 :filter (lambda (&rest junk)
|
|
|
2412 (cdr (custom-menu-create ',symbol))))
|
|
|
2413 ;; But we must create it now under Emacs.
|
|
|
2414 (cons name (cdr (custom-menu-create symbol)))))
|
|
|
2415
|
|
|
2416 ;;; The Custom Mode.
|
|
|
2417
|
|
|
2418 (defvar custom-mode-map nil
|
|
|
2419 "Keymap for `custom-mode'.")
|
|
|
2420
|
|
|
2421 (unless custom-mode-map
|
|
|
2422 (setq custom-mode-map (make-sparse-keymap))
|
|
|
2423 (set-keymap-parent custom-mode-map widget-keymap)
|
|
|
2424 (define-key custom-mode-map "q" 'bury-buffer))
|
|
|
2425
|
|
|
2426 (easy-menu-define custom-mode-customize-menu
|
|
|
2427 custom-mode-map
|
|
149
|
2428 "Menu used to customize customization buffers."
|
|
124
|
2429 (customize-menu-create 'customize))
|
|
28
|
2430
|
|
124
|
2431 (easy-menu-define custom-mode-menu
|
|
|
2432 custom-mode-map
|
|
|
2433 "Menu used in customization buffers."
|
|
|
2434 `("Custom"
|
|
|
2435 ["Set" custom-set t]
|
|
|
2436 ["Save" custom-save t]
|
|
|
2437 ["Reset to Current" custom-reset-current t]
|
|
|
2438 ["Reset to Saved" custom-reset-saved t]
|
|
|
2439 ["Reset to Factory Settings" custom-reset-factory t]
|
|
|
2440 ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
|
|
|
2441
|
|
|
2442 (defcustom custom-mode-hook nil
|
|
|
2443 "Hook called when entering custom-mode."
|
|
|
2444 :type 'hook
|
|
|
2445 :group 'customize)
|
|
|
2446
|
|
|
2447 (defun custom-mode ()
|
|
|
2448 "Major mode for editing customization buffers.
|
|
|
2449
|
|
|
2450 The following commands are available:
|
|
|
2451
|
|
|
2452 Move to next button or editable field. \\[widget-forward]
|
|
|
2453 Move to previous button or editable field. \\[widget-backward]
|
|
|
2454 Activate button under the mouse pointer. \\[widget-button-click]
|
|
|
2455 Activate button under point. \\[widget-button-press]
|
|
|
2456 Set all modifications. \\[custom-set]
|
|
|
2457 Make all modifications default. \\[custom-save]
|
|
|
2458 Reset all modified options. \\[custom-reset-current]
|
|
|
2459 Reset all modified or set options. \\[custom-reset-saved]
|
|
|
2460 Reset all options. \\[custom-reset-factory]
|
|
|
2461
|
|
|
2462 Entry to this mode calls the value of `custom-mode-hook'
|
|
|
2463 if that value is non-nil."
|
|
|
2464 (kill-all-local-variables)
|
|
|
2465 (setq major-mode 'custom-mode
|
|
|
2466 mode-name "Custom")
|
|
|
2467 (use-local-map custom-mode-map)
|
|
|
2468 (easy-menu-add custom-mode-customize-menu)
|
|
|
2469 (easy-menu-add custom-mode-menu)
|
|
|
2470 (make-local-variable 'custom-options)
|
|
|
2471 (run-hooks 'custom-mode-hook))
|
|
28
|
2472
|
|
|
2473 ;;; The End.
|
|
|
2474
|
|
|
2475 (provide 'cus-edit)
|
|
|
2476
|
|
|
2477 ;; cus-edit.el ends here
|
