annotate lisp/cus-edit.el @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents 616e133a0ce6
children 0cb55b2a2c66
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 ;;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
3 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Keywords: help, faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Version: 1.9960-x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; it under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; GNU General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; This file implements the code to create and edit customize buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; See `custom.el'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; No commands should have names starting with `custom-' because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; that interferes with completion. Use `customize-' for commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; that the user will run with M-x, and `Custom-' for interactive commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; NOTE: In many places within this file we use `mapatoms', which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; very slow in an average XEmacs because of the large number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; symbols requiring a large number of funcalls -- XEmacs with Gnus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; can grow to some 17000 symbols without ever doing anything fancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; It would probably pay off to make a hash table of symbols known to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; Custom, similar to custom-group-hash-table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; This is not top priority, because none of the functions that do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; mapatoms are speed-critical (the one that was now uses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; custom-group-hash-table), but it would be nice to have.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (require 'cus-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (require 'wid-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (require 'easymenu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (require 'cus-load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (require 'cus-start)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
58 (require 'cus-file)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; Huh? This looks dirty!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (put 'custom-define-hook 'custom-type 'hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (put 'custom-define-hook 'standard-value '(nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;;; Customization Groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (defgroup emacs nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 "Customization of the One True Editor."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 :link '(custom-manual "(XEmacs)Top"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; Most of these groups are stolen from `finder.el',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (defgroup editing nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 "Basic text editing facilities."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (defgroup matching nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 "Various sorts of searching and matching."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (defgroup emulations nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 "Emulations of other editors."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (defgroup outlines nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 "Support for hierarchical outlining."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (defgroup external nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 "Interfacing to external utilities."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (defgroup bib nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 "Code related to the `bib' bibliography processor."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 :tag "Bibliography"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 :group 'external)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (defgroup programming nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 "Support for programming in other languages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (defgroup languages nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 "Specialized modes for editing programming languages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 :group 'programming)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;; #### This should be in cc-vars.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (defgroup c nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "Support for the C language and related languages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 :group 'languages)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (defgroup tools nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 "Programming tools."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 :group 'programming)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (defgroup oop nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 "Support for object-oriented programming."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 :group 'programming)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (defgroup applications nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 "Applications written in Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;; #### This should be in calendar.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (defgroup calendar nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 "Calendar and time management support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (defgroup mail nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 "Modes for electronic-mail handling."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 (defgroup news nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 "Support for netnews reading and posting."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (defgroup games nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 "Games, jokes and amusements."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 :group 'applications)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (defgroup development nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 "Support for further development of Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (defgroup docs nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 "Support for Emacs documentation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (defgroup extensions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 "Emacs Lisp language extensions."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (defgroup internal nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 "Code for Emacs internals, build process, defaults."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (defgroup maint nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 "Maintenance aids for the Emacs development group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 :tag "Maintenance"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (defgroup environment nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 "Fitting Emacs with its environment."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (defgroup comm nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 "Communications, networking, remote access to files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 :tag "Communication"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (defgroup hardware nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 "Support for interfacing with exotic hardware."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (defgroup terminals nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 "Support for terminal types."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (defgroup unix nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 "Front-ends/assistants for, or emulators of, UNIX features."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (defgroup i18n nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 "Internationalization and alternate character-set support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 :group 'environment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (defgroup data nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 "Support editing files of data."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (defgroup wp nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 "Word processing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (defgroup tex nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 "Code related to the TeX formatter."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 :group 'wp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (defgroup hypermedia nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 "Support for links between text or other media types."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (defgroup local nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 "Code local to your site."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (defgroup customize '((widgets custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 "Customization of the Customization support."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 :link '(custom-manual "(custom)Top")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 :link '(url-link :tag "Development Page"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 "http://www.dina.kvl.dk/~abraham/custom/")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 :group 'help)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (defgroup custom-faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 "Faces used by customize."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 :group 'customize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 :group 'faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (defgroup custom-browse nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 "Control customize browser."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (defgroup custom-buffer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 "Control customize buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (defgroup custom-menu nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 "Control customize menus."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 :prefix "custom-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (defgroup alloc nil
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 555
diff changeset
235 "Storage allocation and gc for XEmacs Lisp interpreter."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 :tag "Storage Allocation"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 :group 'internal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (defgroup undo nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 "Undoing changes in buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (defgroup editing-basics nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 "Most basic editing facilities."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (defgroup display nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 "How characters are displayed in buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (defgroup installation nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 "The Emacs installation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 :group 'environment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (defgroup limits nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 "Internal Emacs limits."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 :group 'internal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (defgroup debug nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 "Debugging Emacs itself."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 :group 'development)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (defgroup mule nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 "Mule XEmacs internationalization."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 :group 'i18n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 ;;; Utilities.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (defun custom-quote (sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 "Quote SEXP iff it is not self quoting."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (if (or (memq sexp '(t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (keywordp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (eq (car-safe sexp) 'lambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (stringp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (numberp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (characterp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (vectorp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (bit-vector-p sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 sexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (list 'quote sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (defun custom-split-regexp-maybe (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 "If REGEXP is a string, split it to a list at `\\|'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 You can get the original back with from the result with:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (mapconcat #'identity result \"\\|\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 IF REGEXP is not a string, return it unchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (if (stringp regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (split-string regexp "\\\\|")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (defun custom-variable-prompt ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 ;; Code stolen from `help.el'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 "Prompt for a variable, defaulting to the variable at point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 Return a list suitable for use in `interactive'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (let ((v (variable-at-point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (enable-recursive-minibuffers t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (setq val (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (if (symbolp v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (format "Customize variable: (default %s) " v)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 "Customize variable: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 obarray (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (and (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (or (get symbol 'custom-type)
476
6a8b2ec80a19 [xemacs-hg @ 2001-04-18 18:18:46 by didierv]
didierv
parents: 456
diff changeset
307 (user-variable-p symbol))))
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
308 t nil nil (and v (symbol-name v))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (list (if (equal val "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (if (symbolp v) v nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (intern val)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 ;; Here we take not only the actual groups, but the loads, too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (defun custom-group-prompt (prompt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 "Read group from minibuffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (let ((completion-ignore-case t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (list (completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 prompt obarray
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (or (get symbol 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (get symbol 'custom-loads)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (defun custom-menu-filter (menu widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 "Convert MENU to the form used by `widget-choose'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 MENU should be in the same format as `custom-variable-menu'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 WIDGET is the widget to apply the filter entries of MENU on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (let ((result nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 current name action filter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (while menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (setq current (car menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 name (nth 0 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 action (nth 1 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 filter (nth 2 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 menu (cdr menu))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (if (or (null filter) (funcall filter widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (push (cons name action) result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (push name result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (nreverse result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 ;;; Unlispify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (defvar custom-prefix-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 "List of prefixes that should be ignored by `custom-unlispify'")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (defcustom custom-unlispify-menu-entries t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 "Display menu entries as words instead of symbols if non nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 :group 'custom-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (defcustom custom-unlispify-remove-prefixes t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 "Non-nil means remove group prefixes from option names in buffers and menus.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 This only has an effect when `custom-unlispify-tag-names' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 `custom-unlispify-menu-entries' is on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 :group 'custom-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 "Convert symbol into a menu entry."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (cond ((not custom-unlispify-menu-entries)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (symbol-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 ((get symbol 'custom-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (if no-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (get symbol 'custom-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (concat (get symbol 'custom-tag) "...")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (with-current-buffer (get-buffer-create " *Custom-Work*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (princ symbol (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (when (and (eq (get symbol 'custom-type) 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (re-search-forward "-p\\'" nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (replace-match "" t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (when custom-unlispify-remove-prefixes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (let ((prefixes custom-prefix-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (while prefixes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (setq prefix (car prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (if (search-forward prefix (+ (point) (length prefix)) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (setq prefixes nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (delete-region (point-min) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (setq prefixes (cdr prefixes))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (subst-char-in-region (point-min) (point-max) ?- ?\ t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (capitalize-region (point-min) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (unless no-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (insert "..."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (buffer-string)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (defcustom custom-unlispify-tag-names t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 "Display tag names as words instead of symbols if non nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 :group 'custom-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (defun custom-unlispify-tag-name (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 "Convert symbol into a menu entry."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (let ((custom-unlispify-menu-entries custom-unlispify-tag-names))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (custom-unlispify-menu-entry symbol t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defun custom-prefix-add (symbol prefixes)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
404 ;; Add SYMBOL to list of ignored PREFIXES.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (cons (or (get symbol 'custom-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (concat (symbol-name symbol) "-"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ;;; Guess.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (defcustom custom-guess-name-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 '(("-p\\'" boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 ("-hooks?\\'" hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ("-face\\'" face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ("-file\\'" file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 ("-function\\'" function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 ("-functions\\'" (repeat function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 ("-list\\'" (repeat sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 ("-alist\\'" (repeat (cons sexp sexp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 "Alist of (MATCH TYPE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 MATCH should be a regexp matching the name of a symbol, and TYPE should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 be a widget suitable for editing the value of that symbol. The TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 of the first entry where MATCH matches the name of the symbol will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 This is used for guessing the type of variables not declared with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 customize."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (defcustom custom-guess-doc-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 '(("\\`\\*?Non-nil " boolean))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 "Alist of (MATCH TYPE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 MATCH should be a regexp matching a documentation string, and TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 should be a widget suitable for editing the value of a variable with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 that documentation string. The TYPE of the first entry where MATCH
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 matches the name of the symbol will be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 This is used for guessing the type of variables not declared with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 customize."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 :group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (defun custom-guess-type (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 "Guess a widget suitable for editing the value of SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 This is done by matching SYMBOL with `custom-guess-name-alist' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 if that fails, the doc string with `custom-guess-doc-alist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (let ((name (symbol-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (names custom-guess-name-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 current found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (while names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (setq current (car names)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 names (cdr names))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (when (string-match (nth 0 current) name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (setq found (nth 1 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 names nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (unless found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (let ((doc (documentation-property symbol 'variable-documentation))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (docs custom-guess-doc-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (when doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (while docs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (setq current (car docs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 docs (cdr docs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (when (string-match (nth 0 current) doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (setq found (nth 1 current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 docs nil))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 ;;; Sorting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (defcustom custom-browse-sort-alphabetically nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 "If non-nil, sort members of each customization group alphabetically."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 :group 'custom-browse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (defcustom custom-browse-order-groups nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 "If non-nil, order group members within each customization group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 If `first', order groups before non-groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 If `last', order groups after non-groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 :type '(choice (const first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (const last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (const :tag "none" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 :group 'custom-browse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (defcustom custom-browse-only-groups nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 "If non-nil, show group members only within each customization group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 :group 'custom-browse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (defcustom custom-buffer-sort-alphabetically nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 "If non-nil, sort members of each customization group alphabetically."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (defcustom custom-buffer-order-groups 'last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 "If non-nil, order group members within each customization group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 If `first', order groups before non-groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 If `last', order groups after non-groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 :type '(choice (const first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (const last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (const :tag "none" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (defcustom custom-menu-sort-alphabetically nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 "If non-nil, sort members of each customization group alphabetically."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 :group 'custom-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (defcustom custom-menu-order-groups 'first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 "If non-nil, order group members within each customization group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 If `first', order groups before non-groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 If `last', order groups after non-groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 :type '(choice (const first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (const last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (const :tag "none" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 :group 'custom-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (defun custom-sort-items (items sort-alphabetically order-groups)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 "Return a sorted copy of ITEMS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 ITEMS should be a `custom-group' property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 If SORT-ALPHABETICALLY non-nil, sort alphabetically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 groups after non-groups, if nil do not order groups at all."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (sort (copy-sequence items)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (lambda (a b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (let ((typea (nth 1 a)) (typeb (nth 1 b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (cond ((not order-groups)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 ;; Since we don't care about A and B order, maybe sort.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (when sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (string-lessp namea nameb)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 ((eq typea 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 ;; If B is also a group, maybe sort. Otherwise, order A and B.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (if (eq typeb 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (when sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (string-lessp namea nameb))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (eq order-groups 'first)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 ((eq typeb 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 ;; Since A cannot be a group, order A and B.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (eq order-groups 'last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 ;; Since A and B cannot be groups, sort.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (string-lessp namea nameb)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 ;;; Custom Mode Commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (defvar custom-options nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 "Customization widgets in the current buffer.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (defun Custom-set ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 "Set changes in all modified options."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (let ((children custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (widget-apply child :custom-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (defun Custom-save ()
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
565 "Set all modified options and save them."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (interactive)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
567 (let ((all-children custom-options)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
568 children)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (when (memq (widget-get child :custom-state) '(modified set))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
571 (push child children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
572 all-children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
573 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
574 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
575 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
576 (widget-apply child :custom-pre-save)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
577 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
578 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
579 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
580 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
581 (widget-apply child :custom-post-save)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
582 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (defvar custom-reset-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 '(("Current" . Custom-reset-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 ("Saved" . Custom-reset-saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 ("Standard Settings" . Custom-reset-standard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 "Alist of actions for the `Reset' button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 The key is a string containing the name of the action, the value is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 lisp function taking the widget as an element which will be called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 when the action is chosen.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (defun custom-reset (event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 "Select item from reset menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (answer (widget-choose "Reset to"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 custom-reset-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (funcall answer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (defun Custom-reset-current (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 "Reset all modified group members to their current value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (let ((children custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (widget-apply child :custom-reset-current)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (defun Custom-reset-saved (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 "Reset all modified or set group members to their saved value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (let ((children custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (widget-apply child :custom-reset-saved)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (defun Custom-reset-standard (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 "Reset all modified, set, or saved group members to their standard settings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (interactive)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
623 (let ((all-children custom-options)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
624 children must-save)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (mapc (lambda (child)
476
6a8b2ec80a19 [xemacs-hg @ 2001-04-18 18:18:46 by didierv]
didierv
parents: 456
diff changeset
626 (when (memq (widget-get child :custom-state) '(modified set saved))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
627 (push child children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
628 all-children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
629 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
630 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
631 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
632 (and (widget-apply child :custom-pre-reset-standard)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
633 (setq must-save t))))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
634 (and must-save (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
635 (let ((the-children children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
636 child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
637 (while (setq child (pop the-children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
638 (widget-apply child :custom-post-reset-standard)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
639 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 ;;; The Customize Commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (defun custom-prompt-variable (prompt-var prompt-val &optional comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 "Prompt for a variable and a value and return them as a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 prompt for the value. The %s escape in PROMPT-VAL is replaced with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 the name of the variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 If the variable has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 If the variable has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 If optional COMMENT argument is non nil, also prompt for a comment and return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 it as the third element in the list."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (let* ((var (read-variable prompt-var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (minibuffer-help-form '(describe-variable var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (let ((prop (get var 'variable-interactive))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (type (get var 'custom-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (prompt (format prompt-val var)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (unless (listp type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (setq type (list type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (cond (prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 ;; Use VAR's `variable-interactive' property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ;; as an interactive spec for prompting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (call-interactively (list 'lambda '(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (list 'interactive prop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 'arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (widget-prompt-value type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (if (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (symbol-value var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (not (boundp var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (eval-minibuffer prompt))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (if comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (list var val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (read-string "Comment: " (get var 'variable-comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (list var val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (defun customize-set-value (var val &optional comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 If VARIABLE has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 If given a prefix (or a COMMENT argument), also prompt for a comment."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (interactive (custom-prompt-variable "Set variable: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 "Set %s to value: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (set var val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (cond ((string= comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (put var 'variable-comment nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (put var 'variable-comment comment))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 ;;;###autoload
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
708 (defun customize-set-variable (variable value &optional comment)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
709 "Set the default for VARIABLE to VALUE. VALUE is any Lisp object.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 If VARIABLE has a `custom-set' property, that is used for setting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 VARIABLE, otherwise `set-default' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 The `customized-value' property of the VARIABLE will be set to a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 with a quoted VALUE as its sole list member.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 If VARIABLE has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 If given a prefix (or a COMMENT argument), also prompt for a comment."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (interactive (custom-prompt-variable "Set variable: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 "Set customized value for %s to: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 current-prefix-arg))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
727 (funcall (or (get variable 'custom-set) 'set-default) variable value)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
728 (put variable 'customized-value (list (custom-quote value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (cond ((string= comment "")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
730 (put variable 'variable-comment nil)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
731 (put variable 'customized-variable-comment nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 (comment
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
733 (put variable 'variable-comment comment)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
734 (put variable 'customized-variable-comment comment))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 ;;;###autoload
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
738 (defun customize-save-variable (variable value &optional comment)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 "Set the default for VARIABLE to VALUE, and save it for future sessions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 If VARIABLE has a `custom-set' property, that is used for setting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 VARIABLE, otherwise `set-default' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 The `customized-value' property of the VARIABLE will be set to a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 with a quoted VALUE as its sole list member.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 it were the arg to `interactive' (which see) to interactively read the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 If VARIABLE has a `custom-type' property, it must be a widget and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 `:prompt-value' property of that widget will be used for reading the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 If given a prefix (or a COMMENT argument), also prompt for a comment."
782
616e133a0ce6 [xemacs-hg @ 2002-03-18 22:22:15 by adrian]
adrian
parents: 776
diff changeset
753 (interactive (custom-prompt-variable "Set and save variable: "
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 "Set and save value for %s as: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 current-prefix-arg))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
756 (funcall (or (get variable 'custom-set) 'set-default) variable value)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
757 (put variable 'saved-value (list (custom-quote value)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
758 (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (cond ((string= comment "")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
760 (put variable 'variable-comment nil)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
761 (put variable 'saved-variable-comment nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (comment
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
763 (put variable 'variable-comment comment)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
764 (put variable 'saved-variable-comment comment)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (custom-save-all))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (defun customize (group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 "Select a customization buffer which you can use to set user options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 User options are structured into \"groups\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 The default group is `Emacs'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (interactive (custom-group-prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 "Customize group: (default emacs) "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (when (stringp group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (if (string-equal "" group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (setq group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (setq group (intern group))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 (let ((name (format "*Customize Group: %s*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 (custom-unlispify-tag-name group))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (if (get-buffer name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 (switch-to-buffer name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (custom-buffer-create (list (list group 'custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (concat " for group "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (custom-unlispify-tag-name group))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (defalias 'customize-group 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (defun customize-other-window (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 "Customize SYMBOL, which must be a customization group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (interactive (custom-group-prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 "Customize group: (default emacs) "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (when (stringp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (if (string-equal "" symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 (setq symbol 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (setq symbol (intern symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (custom-buffer-create-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 (list (list symbol 'custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 (defalias 'customize-group-other-window 'customize-other-window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (defalias 'customize-option 'customize-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 (defun customize-variable (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 "Customize SYMBOL, which must be a user option variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 (interactive (custom-variable-prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (custom-buffer-create (list (list symbol 'custom-variable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 (format "*Customize Variable: %s*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (custom-unlispify-tag-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 (defun customize-changed-options (since-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 "Customize all user option variables whose default values changed recently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 This means, in other words, variables defined with a `:version' keyword."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 (interactive "sCustomize options changed, since version (default all versions): ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 (if (equal since-version "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 (setq since-version nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (and (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (let ((version (get symbol 'custom-version)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 (and version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 (or (null since-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 (customize-version-lessp since-version version))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (push (list symbol 'custom-variable) found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (unless found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 (error "No user options have changed defaults %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 (if since-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 (format "since XEmacs %s" since-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 "in recent Emacs versions")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 (custom-buffer-create (custom-sort-items found t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 "*Customize Changed Options*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (defun customize-version-lessp (version1 version2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (let (major1 major2 minor1 minor2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 (setq major1 (read (match-string 1 version1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 (setq minor1 (read (match-string 2 version1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (setq major2 (read (match-string 1 version2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (setq minor2 (read (match-string 2 version2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 (or (< major1 major2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (and (= major1 major2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (< minor1 minor2)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 (defalias 'customize-variable-other-window 'customize-option-other-window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (defun customize-option-other-window (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 "Customize SYMBOL, which must be a user option variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 Show the buffer in another window, but don't select it."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 (interactive (custom-variable-prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (custom-buffer-create-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (list (list symbol 'custom-variable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 (defun customize-face (&optional symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 "Customize SYMBOL, which should be a face name or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 If SYMBOL is nil, customize all faces."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 (interactive (list (completing-read "Customize face: (default all) "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 obarray 'find-face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 (custom-buffer-create (custom-sort-items
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (mapcar (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 (list symbol 'custom-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (face-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 "*Customize Faces*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 (when (stringp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (setq symbol (intern symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 (check-argument-type 'symbolp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (custom-buffer-create (list (list symbol 'custom-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (format "*Customize Face: %s*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (custom-unlispify-tag-name symbol)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 (defun customize-face-other-window (&optional symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 "Show customization buffer for FACE in other window."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (interactive (list (completing-read "Customize face: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 obarray 'find-face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (if (stringp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 (setq symbol (intern symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (check-argument-type 'symbolp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 (custom-buffer-create-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (list (list symbol 'custom-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (defun customize-customized ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 "Customize all user options set since the last save in this session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 (and (or (get symbol 'customized-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (get symbol 'customized-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (find-face symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (push (list symbol 'custom-face) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 (and (or (get symbol 'customized-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 (get symbol 'customized-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (push (list symbol 'custom-variable) found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (if (not found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 (error "No customized user options")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 (custom-buffer-create (custom-sort-items found t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 "*Customize Customized*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 (defun customize-saved ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 "Customize all already saved user options."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (and (or (get symbol 'saved-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 (find-face symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 (push (list symbol 'custom-face) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 (and (or (get symbol 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 (get symbol 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (push (list symbol 'custom-variable) found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 (if (not found )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 (error "No saved user options")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 (custom-buffer-create (custom-sort-items found t nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 "*Customize Saved*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (defun customize-apropos (regexp &optional all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 "Customize all user options matching REGEXP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 If ALL is `options', include only options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 If ALL is `faces', include only faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 If ALL is `groups', include only groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 If ALL is t (interactively, with prefix arg), include options which are not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 user-settable, as well as faces and groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (interactive "sCustomize regexp: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 (let ((found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 (when (string-match regexp (symbol-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 (when (and (not (memq all '(faces options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 (get symbol 'custom-group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (push (list symbol 'custom-group) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (when (and (not (memq all '(options groups)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 (find-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 (push (list symbol 'custom-face) found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 (when (and (not (memq all '(groups faces)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (or (get symbol 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (if (memq all '(nil options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 (user-variable-p symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 (get symbol 'variable-documentation))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 (push (list symbol 'custom-variable) found)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 (if (not found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 (error "No matches")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 (custom-buffer-create (custom-sort-items found t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 custom-buffer-order-groups)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 "*Customize Apropos*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (defun customize-apropos-options (regexp &optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 "Customize all user options matching REGEXP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 With prefix arg, include options which are not user-settable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 (interactive "sCustomize regexp: \nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (customize-apropos regexp (or arg 'options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 (defun customize-apropos-faces (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 "Customize all user faces matching REGEXP."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (interactive "sCustomize regexp: \n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 (customize-apropos regexp 'faces))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 (defun customize-apropos-groups (regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 "Customize all user groups matching REGEXP."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 (interactive "sCustomize regexp: \n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 (customize-apropos regexp 'groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 ;;; Buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 (defcustom custom-buffer-style 'links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 "*Control the presentation style for customization buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 The value should be a symbol, one of:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 brackets: groups nest within each other with big horizontal brackets.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 links: groups have links to subgroups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 :type '(radio (const :tag "brackets: Groups nest within each others" brackets)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 (const :tag "links: Group have links to subgroups" links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (defcustom custom-buffer-done-function 'kill-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 "*Function to be used to remove the buffer when the user is done with it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 Choices include `kill-buffer' (the default) and `bury-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 The function will be called with one argument, the buffer to remove."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 :type '(radio (function-item kill-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 (function-item bury-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (function :tag "Other" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (defcustom custom-buffer-indent 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 "Number of spaces to indent nested groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 (defun custom-buffer-create (options &optional name description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 "Create a buffer containing OPTIONS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 Optional NAME is the name of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 SYMBOL is a customization option, and WIDGET is a widget for editing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 that option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 (unless name (setq name "*Customization*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 (kill-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 (switch-to-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 (custom-buffer-create-internal options description))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 (defun custom-buffer-create-other-window (options &optional name description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 "Create a buffer containing OPTIONS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 Optional NAME is the name of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 SYMBOL is a customization option, and WIDGET is a widget for editing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 that option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 (unless name (setq name "*Customization*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 (kill-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 (let ((window (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 (switch-to-buffer-other-window (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 (custom-buffer-create-internal options description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (select-window window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (defcustom custom-reset-button-menu t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 "If non-nil, only show a single reset button in customize buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 This button will have a menu with all three reset operations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 (defconst custom-skip-messages 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (defun Custom-buffer-done ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 "Remove current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 This works by calling the function specified by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 `custom-buffer-done-function'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (funcall custom-buffer-done-function (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (defun custom-buffer-create-buttons ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 (message "Creating customization buttons...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 (widget-insert "\nOperate on everything in this buffer:\n ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 :tag "Set"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 Make your editing in this buffer take effect for this session"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 (Custom-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 :tag "Save"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 Make your editing in this buffer take effect for future Emacs sessions"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (Custom-save)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (if custom-reset-button-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 :tag "Reset"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 :tag-glyph '("reset-up" "reset-down")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 :help-echo "Show a menu with reset operations"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 :mouse-down-action (lambda (&rest junk) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 (custom-reset event))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 :tag "Reset"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 Reset all edited text in this buffer to reflect current values"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 :action 'Custom-reset-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 :tag "Reset to Saved"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 Reset all values in this buffer to their saved settings"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 :action 'Custom-reset-saved)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 :tag "Reset to Standard"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 :help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 Reset all values in this buffer to their standard settings"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 :action 'Custom-reset-standard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 (widget-insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (widget-create 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 :tag "Done"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 :help-echo "Remove the buffer"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 :action (lambda (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (Custom-buffer-done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 (defcustom custom-novice t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 "If non-nil, show help message at top of customize buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 (defcustom custom-display-global-buttons 'top
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 "If `nil' don't display the global buttons. If `top' display at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 beginning of custom buffers. If `bottom', display at the end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 :type '(choice (const top)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (const bottom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (const :tag "don't" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (defun custom-buffer-create-internal (options &optional description)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 (message "Creating customization buffer...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 (custom-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (widget-insert "This is a customization buffer")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 (if description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 (widget-insert description))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 (when custom-novice
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 (widget-insert ".\n\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 Type RET or click button2 on an active field to invoke its action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 Invoke ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 (widget-create 'info-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 :tag "Help"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 :help-echo "Read the online help"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 "(XEmacs)Easy Customization")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 (widget-insert " for more information."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 (widget-insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 (if (equal custom-display-global-buttons 'top)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 (custom-buffer-create-buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 (widget-insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 (message "Creating customization items...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 (setq custom-options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 (if (= (length options) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 (mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 (widget-create (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 :documentation-shown t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 :custom-state 'unknown
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 :tag (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 :value (nth 0 entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 options)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 (let ((count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 (length (length options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 (mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 (prog2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 'progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 (format "Creating customization items %2d%%..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 (/ (* 100.0 count) length)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 (widget-create (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 :tag (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 :value (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (incf count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 (widget-insert "\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 options))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 (if (equal custom-display-global-buttons 'bottom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 (custom-buffer-create-buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 (display-message 'progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 "Creating customization items %2d%%...done" 100))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 (unless (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 (mapc 'custom-magic-reset custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 (message "Creating customization setup...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 (widget-setup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 (message "Creating customization buffer...done"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 ;;; The Tree Browser.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 (defun customize-browse (&optional group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 "Create a tree browser for the customize hierarchy."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 (unless group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 (setq group 'emacs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 (let ((name "*Customize Browser*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 (kill-buffer (get-buffer-create name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 (switch-to-buffer (get-buffer-create name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 (custom-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 (widget-insert "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 Square brackets show active fields; type RET or click button2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 on an active field to invoke its action.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 (if custom-browse-only-groups
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 (widget-insert "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 Invoke the [Group] button below to edit that item in another window.\n\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 (widget-insert "Invoke the ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 (widget-create 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 :format "%t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 :tag "[Group]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 :tag-glyph "folder")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 (widget-insert ", ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 (widget-create 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 :format "%t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 :tag "[Face]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 :tag-glyph "face")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 (widget-insert ", and ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 (widget-create 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 :format "%t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 :tag "[Option]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 :tag-glyph "option")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 (widget-insert " buttons below to edit that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 item in another window.\n\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 (let ((custom-buffer-style 'tree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 (widget-create 'custom-group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 :custom-last t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 :custom-state 'unknown
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 :tag (custom-unlispify-tag-name group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 :value group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 (widget-add-change)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 (define-widget 'custom-browse-visibility 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 "Control visibility of of items in the customize tree browser."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 :format "%[[%t]%]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 :action 'custom-browse-visibility-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 (defun custom-browse-visibility-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 (let ((custom-buffer-style 'tree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 (custom-toggle-parent widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 (define-widget 'custom-browse-group-tag 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 :tag "Group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 :tag-glyph "folder"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 :action 'custom-browse-group-tag-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 (defun custom-browse-group-tag-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 (let ((parent (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 (customize-group-other-window (widget-value parent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 (define-widget 'custom-browse-variable-tag 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 :tag "Option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 :tag-glyph "option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 :action 'custom-browse-variable-tag-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 (defun custom-browse-variable-tag-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 (let ((parent (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 (customize-variable-other-window (widget-value parent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 (define-widget 'custom-browse-face-tag 'push-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 :tag "Face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 :tag-glyph "face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 :action 'custom-browse-face-tag-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (defun custom-browse-face-tag-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 (let ((parent (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 (customize-face-other-window (widget-value parent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 (defconst custom-browse-alist '((" " "space")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 (" | " "vertical")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 ("-\\ " "top")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 (" |-" "middle")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 (" `-" "bottom")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 (defun custom-browse-insert-prefix (prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 "Insert PREFIX. On XEmacs convert it to line graphics."
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1274 ;; #### Unfinished.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 (if nil ; (string-match "XEmacs" emacs-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 (insert "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 (while (not (string-equal prefix ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 (let ((entry (substring prefix 0 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 (setq prefix (substring prefix 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 (name (nth 1 (assoc entry custom-browse-alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 (overlay-put overlay 'start-open t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 (overlay-put overlay 'end-open t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 (insert prefix)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 ;;; Modification of Basic Widgets.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 ;; We add extra properties to the basic widgets needed here. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 ;; fine, as long as we are careful to stay within out own namespace.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 ;; We want simple widgets to be displayed by default, but complex
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 ;; widgets to be hidden.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 (widget-put (get 'item 'widget-type) :custom-show t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 (widget-put (get 'editable-field 'widget-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 :custom-show (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 ;; This used to call pp-to-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 (let ((pp (widget-prettyprint-to-string value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 (cond ((string-match "\n" pp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 ((> (length pp) 40)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 (t t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 (widget-put (get 'menu-choice 'widget-type) :custom-show t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 ;;; The `custom-manual' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 (define-widget 'custom-manual 'info-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 "Link to the manual entry for this customization option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 :tag "Manual")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 ;;; The `custom-magic' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 (defgroup custom-magic-faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 "Faces used by the magic button."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 :group 'custom-faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 (defface custom-invalid-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 (:foreground "yellow" :background "red"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 (:bold t :italic t :underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 "Face used when the customize item is invalid."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 (defface custom-rogue-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 (:foreground "pink" :background "black"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 "Face used when the customize item is not defined for customization."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 (defface custom-modified-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 (:foreground "white" :background "blue"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 (:italic t :bold)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 "Face used when the customize item has been modified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 (defface custom-set-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 (:foreground "blue" :background "white"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 (:italic t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 "Face used when the customize item has been set."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 (defface custom-changed-face '((((class color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 (:foreground "white" :background "blue"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 (:italic t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 "Face used when the customize item has been changed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 (defface custom-saved-face '((t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 "Face used when the customize item has been saved."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 :group 'custom-magic-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 (defconst custom-magic-alist '((nil "#" underline "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 uninitialized, you should not see this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 (unknown "?" italic "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 unknown, you should not see this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 (hidden "-" default "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 hidden, invoke \"Show\" button in the previous line to show." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 group now hidden, invoke the above \"Show\" button to show contents.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 (invalid "x" custom-invalid-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 the value displayed for this %c is invalid and cannot be set.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 (modified "*" custom-modified-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 you have edited the value as text, but you have not set the %c." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 you have edited something in this group, but not set it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 (set "+" custom-set-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 you have set this %c, but not saved it for future sessions." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 something in this group has been set, but not saved.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 (changed ":" custom-changed-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 this %c has been changed outside the customize buffer." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 something in this group has been changed outside customize.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 (saved "!" custom-saved-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 this %c has been set and saved." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 something in this group has been set and saved.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 (rogue "@" custom-rogue-face "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 this %c has not been changed with customize." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 something in this group is not prepared for customization.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 (standard " " nil "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 this %c is unchanged from its standard setting." "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 visible group members are all at standard settings."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 "Alist of customize option states.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 STATE is one of the following symbols:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 For internal use, should never occur.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 `unknown'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 For internal use, should never occur.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 `hidden'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 This item is not being displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 `invalid'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 This item is modified, but has an invalid form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 `modified'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 This item is modified, and has a valid form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 `set'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 This item has been set but not saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 `changed'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 The current value of this item has been changed temporarily.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 `saved'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 This item is marked for saving.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 `rogue'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 This item has no customization information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 `standard'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 This item is unchanged from the standard setting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 MAGIC is a string used to present that state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 FACE is a face used to present the state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 ITEM-DESC is a string describing the state for options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 GROUP-DESC is a string describing the state for groups. If this is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 left out, ITEM-DESC will be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 The string %c in either description will be replaced with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 category of the item. These are `group'. `option', and `face'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 The list should be sorted most significant first.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 (defcustom custom-magic-show 'long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 "If non-nil, show textual description of the state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 If `long', show a full-line description, not just one word."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 :type '(choice (const :tag "no" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 (const short)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 (const long))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 (defcustom custom-magic-show-hidden '(option face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 "Control whether the State button is shown for hidden items.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 The value should be a list with the custom categories where the State
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 button should be visible. Possible categories are `group', `option',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 and `face'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 :type '(set (const group) (const option) (const face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 (defcustom custom-magic-show-button nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 "Show a \"magic\" button indicating the state of each customization option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 (define-widget 'custom-magic 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 "Show and manipulate state for a customization option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 :action 'widget-parent-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 :notify 'ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 :value-get 'ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 :value-create 'custom-magic-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 :value-delete 'widget-children-value-delete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 (defun widget-magic-mouse-down-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 ;; Non-nil unless hidden.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 :custom-state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 (defun custom-magic-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 ;; Create compact status report for WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 (let* ((parent (widget-get widget :parent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 (state (widget-get parent :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 (hidden (eq state 'hidden))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 (entry (assq state custom-magic-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 (magic (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 (face (nth 2 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 (category (widget-get parent :custom-category))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 (text (or (and (eq category 'group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 (nth 4 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 (nth 3 entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 (form (widget-get parent :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 (setq text (concat (match-string 1 text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 (symbol-name category)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 (match-string 2 text))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 (when (and custom-magic-show
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 (or (not hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 (memq category custom-magic-show-hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 (when (and (eq category 'group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 (not (and (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 (> (widget-get parent :custom-level) 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 (insert-char ?\ (* custom-buffer-indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 (widget-get parent :custom-level))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 widget 'choice-item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 :help-echo "Change the state of this item"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 :format (if hidden "%t" "%[%t%]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 :button-prefix 'widget-push-button-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 :button-suffix 'widget-push-button-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 :mouse-down-action 'widget-magic-mouse-down-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 :tag "State"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 ;;:tag-glyph (or hidden '("state-up" "state-down"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 (insert ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 (let ((start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 (if (eq custom-magic-show 'long)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 (insert text)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 (insert (symbol-name state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 (cond ((eq form 'lisp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 (insert " (lisp)"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 ((eq form 'mismatch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (insert " (mismatch)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 (put-text-property start (point) 'face 'custom-state-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 (insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 (when (and (eq category 'group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 (not (and (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 (> (widget-get parent :custom-level) 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 (insert-char ?\ (* custom-buffer-indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 (widget-get parent :custom-level))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 (when custom-magic-show-button
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 (when custom-magic-show
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 (let ((indent (widget-get parent :indent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 (when indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 (insert-char ?\ indent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 widget 'choice-item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 :mouse-down-action 'widget-magic-mouse-down-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 :button-face face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 :button-prefix ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 :button-suffix ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 :help-echo "Change the state"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 :format (if hidden "%t" "%[%t%]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 :tag (if (memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 (concat "(" magic ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 (concat "[" magic "]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 (insert " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 (widget-put widget :children children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 (defun custom-magic-reset (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 "Redraw the :custom-magic property of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 (let ((magic (widget-get widget :custom-magic)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 (widget-value-set magic (widget-value magic))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 ;;; The `custom' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 (defface custom-button-face '((t (:bold t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 "Face used for buttons in customization buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 (defface custom-documentation-face nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 "Face used for documentation strings in customization buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 (defface custom-state-face '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 (:foreground "lime green"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 (:foreground "dark green"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 (t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 "Face used for State descriptions in the customize buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 (define-widget 'custom 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 "Customize a user option."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 :convert-widget 'custom-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 :notify 'custom-notify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 :custom-prefix ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 :custom-level 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 :custom-state 'hidden
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 :documentation-property 'widget-subclass-responsibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 :value-create 'widget-subclass-responsibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 :value-delete 'widget-children-value-delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 :value-get 'widget-value-value-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 :validate 'widget-children-validate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 :match (lambda (widget value) (symbolp value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 (defun custom-convert-widget (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 ;; Initialize :value and :tag from :args in WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 (let ((args (widget-get widget :args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (when args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 (widget-put widget :value (widget-apply widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 :value-to-internal (car args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 (widget-put widget :tag (custom-unlispify-tag-name (car args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 (widget-put widget :args nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 (defun custom-notify (widget &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 "Keep track of changes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 (let ((state (widget-get widget :custom-state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 (unless (eq state 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 (unless (memq state '(nil unknown hidden))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 (widget-put widget :custom-state 'modified))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 (custom-magic-reset widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 (apply 'widget-default-notify widget args))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 (defun custom-redraw (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 "Redraw WIDGET with current settings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 (let ((line (count-lines (point-min) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 (column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 (pos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 (from (marker-position (widget-get widget :from)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 (to (marker-position (widget-get widget :to))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 (widget-value-set widget (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 (custom-redraw-magic widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 (when (and (>= pos from) (<= pos to))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 (if (> column 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 (goto-line line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 (goto-line (1+ line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 (move-to-column column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 (error nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 (defun custom-redraw-magic (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 "Redraw WIDGET state with current settings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 (while widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 (let ((magic (widget-get widget :custom-magic)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 (cond (magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 (widget-value-set magic (widget-value magic))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 (when (setq widget (widget-get widget :group))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 (custom-group-state-update widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 (setq widget nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (widget-setup))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 (defun custom-show (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 "Non-nil if WIDGET should be shown with VALUE by default."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 (let ((show (widget-get widget :custom-show)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 (cond ((null show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 ((eq t show)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 (funcall show widget value)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 (defvar custom-load-recursion nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 "Hack to avoid recursive dependencies.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 (defun custom-load-symbol (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 "Load all dependencies for SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 (unless custom-load-recursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 (let ((custom-load-recursion t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 (loads (get symbol 'custom-loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 (while loads
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 (setq load (car loads)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 loads (cdr loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 (cond ((symbolp load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 (require load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 ;; Don't reload a file already loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 ((and (boundp 'preloaded-file-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 (member load preloaded-file-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 ((assoc load load-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 ((assoc (locate-library load) load-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 ;; Without this, we would load cus-edit recursively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 ;; We are still loading it when we call this,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 ;; and it is not in load-history yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 (or (equal load "cus-edit")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 (load-library load))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 (error nil))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 (defun custom-load-widget (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 "Load all dependencies for WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 (custom-load-symbol (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 (defun custom-unloaded-symbol-p (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 "Return non-nil if the dependencies of SYMBOL has not yet been loaded."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 (let ((found nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 (loads (get symbol 'custom-loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 (while loads
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 (setq load (car loads)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 loads (cdr loads))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 (cond ((symbolp load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 (unless (featurep load)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 (setq found t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 ((assoc load load-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 ((assoc (locate-library load) load-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 ;; #### WTF???
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 (message nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 (setq found t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 (defun custom-unloaded-widget-p (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 "Return non-nil if the dependencies of WIDGET has not yet been loaded."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 (custom-unloaded-symbol-p (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 (defun custom-toggle-hide (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 "Toggle visibility of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 (let ((state (widget-get widget :custom-state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 (cond ((memq state '(invalid modified))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 (error "There are unset changes"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 (widget-put widget :custom-state 'unknown))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 (widget-put widget :documentation-shown nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 (widget-put widget :custom-state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 (custom-redraw widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 (widget-setup)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 (defun custom-toggle-parent (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 "Toggle visibility of parent of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 (custom-toggle-hide (widget-get widget :parent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 (defun custom-add-see-also (widget &optional prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 "Add `See also ...' to WIDGET if there are any links.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 Insert PREFIX first if non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 (let* ((symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 (links (get symbol 'custom-links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 (many (> (length links) 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 (buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 (indent (widget-get widget :indent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 (when links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 (when indent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 (insert-char ?\ indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 (when prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 (insert prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 (insert "See also ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 (while links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 (push (widget-create-child-and-convert widget (car links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 (setq links (cdr links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 (cond ((null links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 (insert ".\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 ((null (cdr links))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 (if many
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 (insert ", and ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 (insert " and ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 (insert ", "))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 (widget-put widget :buttons buttons))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 (defun custom-add-parent-links (widget &optional initial-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 "Add \"Parent groups: ...\" to WIDGET if the group has parents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 The value if non-nil if any parents were found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 (let ((name (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 (type (widget-type widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 (buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 (start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 (insert (or initial-string "Parent groups:"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 (maphash (lambda (group ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 (let ((entry (assq name (get group 'custom-group))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 (when (eq (nth 1 entry) type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 widget 'custom-group-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 :tag (custom-unlispify-tag-name group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 (setq found t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 custom-group-hash-table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 (if found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 (delete-region start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 ;;; The `custom-comment' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 ;; like the editable field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 (defface custom-comment-face '((((class grayscale color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 (:background "gray85"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 (((class grayscale color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 (:background "dim gray"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 (:italic t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 "Face used for comments on variables or faces"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 ;; like font-lock-comment-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 (defface custom-comment-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 '((((class color) (background dark)) (:foreground "gray80"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 (((class color) (background light)) (:foreground "blue4"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 (((class grayscale) (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 (:foreground "DimGray" :bold t :italic t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 (((class grayscale) (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 (:foreground "LightGray" :bold t :italic t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 (t (:bold t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 "Face used for variables or faces comment tags"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 (define-widget 'custom-comment 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 "User comment"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 :tag "Comment"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 :help-echo "Edit a comment here"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 :sample-face 'custom-comment-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 :value-face 'custom-comment-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 :value-set 'custom-comment-value-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 :create 'custom-comment-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 :delete 'custom-comment-delete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 (defun custom-comment-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 (let (ext)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 (widget-default-create widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 (widget-put widget :comment-extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 (setq ext (make-extent (widget-get widget :from)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 (widget-get widget :to))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 (set-extent-property ext 'start-open t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 (when (equal (widget-get widget :value) "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 (set-extent-property ext 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 (defun custom-comment-delete (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 (widget-default-delete widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 (delete-extent (widget-get widget :comment-extent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 (defun custom-comment-value-set (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 (widget-default-value-set widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 (if (equal value "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 (set-extent-property (widget-get widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 'invisible t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 (set-extent-property (widget-get widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 'invisible nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 ;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 ;; the global custom one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 (defun custom-comment-show (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 (set-extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 (widget-get (widget-get widget :comment-widget) :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 'invisible nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 (defun custom-comment-invisible-p (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 (extent-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 (widget-get (widget-get widget :comment-widget) :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 ;;; The `custom-variable' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 (defface custom-variable-tag-face '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 (:foreground "light blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (:foreground "blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 (t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 "Face used for unpushable variable tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 (defface custom-variable-button-face '((t (:underline t :bold t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 "Face used for pushable variable tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 (defcustom custom-variable-default-form 'edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 "Default form of displaying variable values."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 :type '(choice (const edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 (const lisp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 (define-widget 'custom-variable 'custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 "Customize variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 :help-echo "Set or reset this variable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 :documentation-property 'variable-documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 :custom-category 'option
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 :custom-state nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 :custom-menu 'custom-variable-menu-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 :custom-form nil ; defaults to value of `custom-variable-default-form'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 :value-create 'custom-variable-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 :action 'custom-variable-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 :custom-set 'custom-variable-set
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
1873 :custom-pre-save 'custom-variable-pre-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 :custom-save 'custom-variable-save
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
1875 :custom-post-save 'custom-variable-post-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 :custom-reset-current 'custom-redraw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 :custom-reset-saved 'custom-variable-reset-saved
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
1878 :custom-pre-reset-standard 'custom-variable-pre-reset-standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
1879 :custom-reset-standard 'custom-variable-reset-standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
1880 :custom-post-reset-standard 'custom-variable-post-reset-standard)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 (defun custom-variable-type (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 "Return a widget suitable for editing the value of SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 If SYMBOL has a `custom-type' property, use that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 Otherwise, look up symbol in `custom-guess-type-alist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 (let* ((type (or (get symbol 'custom-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 (and (not (get symbol 'standard-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 (custom-guess-type symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 'sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 (options (get symbol 'custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 (tmp (if (listp type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 (copy-sequence type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 (list type))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 (when options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 (widget-put tmp :options options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 tmp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 (defun custom-variable-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 "Here is where you edit the variables value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 (unless (widget-get widget :custom-form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 (widget-put widget :custom-form custom-variable-default-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 (let* ((buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 (children (widget-get widget :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 (form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 (tag (widget-get widget :tag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 (type (custom-variable-type symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 (conv (widget-convert type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (get (or (get symbol 'custom-get) 'default-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 (prefix (widget-get widget :custom-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 (last (widget-get widget :custom-last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 (value (if (default-boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 (funcall get symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 (widget-get conv :value))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 ;; If the widget is new, the child determine whether it is hidden.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 (cond (state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 ((custom-show type value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 (setq state 'unknown))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 (setq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 ;; If we don't know the state, see if we need to edit it in lisp form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 (when (eq state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 (unless (widget-apply conv :match value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 ;; (widget-apply (widget-convert type) :match value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 (setq form 'mismatch)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 ;; Now we can create the child widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 (cond ((eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 (insert prefix (if last " `--- " " |--- "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 widget 'custom-browse-variable-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 ;; Indicate hidden value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 widget 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 :format "%{%t%}: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 :sample-face 'custom-variable-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 :tag tag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 :parent widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 :help-echo "Show the value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 ((memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 ;; In lisp mode edit the saved value when possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 (let* ((value (cond ((get symbol 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 (car (get symbol 'saved-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 ((get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 (car (get symbol 'standard-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 ((default-boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 (custom-quote (funcall get symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 (custom-quote (widget-get conv :value))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 (insert (symbol-name symbol) ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 :help-echo "Hide the value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 widget 'sexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 :button-face 'custom-variable-button-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 :tag (symbol-name symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 :parent widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 :value value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 ;; Edit mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 (let* ((format (widget-get type :format))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 tag-format value-format)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 (while (not (string-match ":" format))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 (setq format (signal 'error (list "Bad format" format))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 (setq tag-format (substring format 0 (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 (setq value-format (substring format (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 widget 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 :format tag-format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 :action 'custom-tag-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 :help-echo "Change value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 :mouse-down-action 'custom-tag-mouse-down-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 :button-face 'custom-variable-button-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 :sample-face 'custom-variable-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 :help-echo "Hide the value of this option"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 widget type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 :format value-format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 :value value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 children))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 (unless (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 (widget-insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 ;; Create the magic button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 widget 'custom-magic nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 ;; Insert documentation.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2016 ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 ;; before the call to `widget-default-format-handler'. Otherwise, I
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2018 ;; lose my current `buttons'. This function shouldn't be called like
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 ;; this anyway. The doc string widget should be added like the others.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 ;; --dv
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 (widget-default-format-handler widget ?h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 ;; The comment field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 (let* ((comment (get symbol 'variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 (comment-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 widget 'custom-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 :parent widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 :value (or comment ""))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 (widget-put widget :comment-widget comment-widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 ;; Don't push it !!! Custom assumes that the first child is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 ;; value one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 (setq children (append children (list comment-widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 ;; Update the rest of the properties properties.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 (widget-put widget :custom-form form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 (widget-put widget :children children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 ;; Now update the state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 (if (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 (widget-put widget :custom-state state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 (custom-variable-state-set widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 ;; See also.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 (when (eq (widget-get widget :custom-level) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 (custom-add-parent-links widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 (custom-add-see-also widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 (defun custom-tag-action (widget &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 "Pass :action to first child of WIDGET's parent."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 :action args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 (defun custom-tag-mouse-down-action (widget &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 "Pass :mouse-down-action to first child of WIDGET's parent."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 :mouse-down-action args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 (defun custom-variable-state-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 "Set the state of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 (get (or (get symbol 'custom-get) 'default-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 (value (if (default-boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 (funcall get symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 (widget-get widget :value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 (comment (get symbol 'variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 tmp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 (state (cond ((progn (setq tmp (get symbol 'customized-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 (setq temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 (get symbol 'customized-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 (if (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 (and (equal value (eval (car tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 (equal comment temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 'set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 ((progn (setq tmp (get symbol 'saved-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 (setq temp (get symbol 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 (if (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 (and (equal value (eval (car tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 (equal comment temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 'saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 ((setq tmp (get symbol 'standard-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 (if (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 (and (equal value (eval (car tmp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 (equal comment nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 'standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 (t 'rogue))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 (widget-put widget :custom-state state)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 (defvar custom-variable-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 '(("Set for Current Session" custom-variable-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 (eq (widget-get widget :custom-state) 'modified)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 ("Save for Future Sessions" custom-variable-save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 (memq (widget-get widget :custom-state) '(modified set changed rogue))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 ("Reset to Current" custom-redraw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 (and (default-boundp (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 (memq (widget-get widget :custom-state) '(modified changed)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 ("Reset to Saved" custom-variable-reset-saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 (and (or (get (widget-value widget) 'saved-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 (get (widget-value widget) 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 (memq (widget-get widget :custom-state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 '(modified set changed rogue)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 ("Reset to Standard Settings" custom-variable-reset-standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 (and (get (widget-value widget) 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 (memq (widget-get widget :custom-state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 '(modified set changed saved rogue)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 ("Add Comment" custom-comment-show custom-comment-invisible-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 ("Don't show as Lisp expression" custom-variable-edit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 (eq (widget-get widget :custom-form) 'lisp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 ("Show as Lisp expression" custom-variable-edit-lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 (eq (widget-get widget :custom-form) 'edit))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 "Alist of actions for the `custom-variable' widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 the menu entry, ACTION is the function to call on the widget when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 menu is selected, and FILTER is a predicate which takes a `custom-variable'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 widget as an argument, and returns non-nil if ACTION is valid on that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 widget. If FILTER is nil, ACTION is always valid.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 (defun custom-variable-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 "Show the menu for `custom-variable' WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 Optional EVENT is the location for the menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 (if (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 (custom-toggle-hide widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 (unless (eq (widget-get widget :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 (custom-variable-state-set widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 ;; Redrawing magic also depresses the state glyph.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 ;(custom-redraw-magic widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 (answer (widget-choose (concat "Operation on "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 (widget-get widget :value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 (custom-menu-filter custom-variable-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 (funcall answer widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 (defun custom-variable-edit (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 "Edit value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 (widget-put widget :custom-form 'edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 (defun custom-variable-edit-lisp (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 "Edit the lisp representation of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 (widget-put widget :custom-form 'lisp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 (defun custom-variable-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 "Set the current value for the variable being edited by WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 (let* ((form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 (symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 (set (or (get symbol 'custom-set) 'set-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 (comment (widget-value comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 (cond ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 (error "Cannot set hidden variable"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 ((setq val (widget-apply child :validate))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 (goto-char (widget-get val :from))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 (error "%s" (widget-get val :error)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 ((memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 (funcall set symbol (eval (setq val (widget-value child))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 (put symbol 'customized-value (list val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 (put symbol 'customized-variable-comment comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 (funcall set symbol (setq val (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 (put symbol 'customized-value (list (custom-quote val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 (put symbol 'customized-variable-comment comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 (custom-variable-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 (custom-redraw-magic widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2204 (defun custom-variable-pre-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2205 "Prepare for saving the value for the variable being edited by WIDGET."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 (let* ((form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 (symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 (set (or (get symbol 'custom-set) 'set-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 (comment (widget-value comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 (cond ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 (error "Cannot set hidden variable"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 ((setq val (widget-apply child :validate))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 (goto-char (widget-get val :from))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 (error "%s" (widget-get val :error)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 ((memq form '(lisp mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 (put symbol 'saved-value (list (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 (custom-push-theme 'theme-value symbol 'user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 'set (list (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 (funcall set symbol (eval (widget-value child)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 (put symbol 'saved-variable-comment comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 (put symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 'saved-value (list (custom-quote (widget-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 child))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 (custom-push-theme 'theme-value symbol 'user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 'set (list (custom-quote (widget-value
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2242 child))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 (funcall set symbol (widget-value child))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 (put symbol 'saved-variable-comment comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 (put symbol 'customized-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 (put symbol 'customized-variable-comment nil)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2248 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2249
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2250 (defun custom-variable-post-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2251 "Finish saving the variable being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2252 (custom-variable-state-set widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2253 (custom-redraw-magic widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2254
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2255 (defun custom-variable-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2256 "Set and save the value for the variable being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2257 (custom-variable-pre-save widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2258 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2259 (custom-variable-post-save widget))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 (defun custom-variable-reset-saved (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 "Restore the saved value for the variable being edited by WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 (set (or (get symbol 'custom-set) 'set-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 (value (get symbol 'saved-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 (comment (get symbol 'saved-variable-comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 (cond ((or value comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 (put symbol 'variable-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 (funcall set symbol (eval (car value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 (signal 'error (list "No saved value for variable" symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 (put symbol 'customized-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 (put symbol 'customized-variable-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 ;; This call will possibly make the comment invisible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 (custom-redraw widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2280 ;; This function returns non nil if we need to re-save the options --dv.
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2281 (defun custom-variable-pre-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2282 "Prepare for restoring the variable being edited by WIDGET to its
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2283 standard setting."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 (let* ((symbol (widget-value widget))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2285 (set (or (get symbol 'custom-set) 'set-default)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 (if (get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 (funcall set symbol (eval (car (get symbol 'standard-value))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 (signal 'error (list "No standard setting known for variable" symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 (put symbol 'variable-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 (put symbol 'customized-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 (put symbol 'customized-variable-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 (put symbol 'saved-value nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 ;; As a special optimizations we do not (explictly)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2296 ;; save resets to standard when no theme sets the value.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 (if (null (cdr (get symbol 'theme-value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 (put symbol 'theme-value nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 (put symbol 'saved-variable-comment nil)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2300 widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2301 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2302
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2303 (defun custom-variable-post-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2304 "Finish resetting the variable being edited by WIDGET to its standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2305 value."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2306 (widget-put widget :custom-state 'unknown)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2307 ;; This call will possibly make the comment invisible
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2308 (custom-redraw widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2309
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2310 (defun custom-variable-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2311 "Restore the standard setting for the variable being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2312 (when (custom-variable-pre-reset-standard widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2313 (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2314 (custom-variable-post-reset-standard widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2315
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 ;;; The `custom-face-edit' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 (define-widget 'custom-face-edit 'checklist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 "Edit face attributes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 :format "%t: %v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 :tag "Attributes"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 :extra-offset 12
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
2324 :button-args '(:help-echo "Control whether this attribute has any effect")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 :args (mapcar (lambda (att)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 (list 'group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 :sibling-args (widget-get (nth 1 att) :sibling-args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 (list 'const :format "" :value (nth 0 att))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 (nth 1 att)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 custom-face-attributes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 ;;; The `custom-display' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (define-widget 'custom-display 'menu-choice
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 "Select a display type."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 :tag "Display"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 :value t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 :help-echo "Specify frames where the face attributes should be used"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 :args '((const :tag "all" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 (checklist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 :extra-offset 9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 :args ((group :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 Only match the specified window systems")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 (const :format "Type: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 (checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 (const :format "X "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 The X11 Window System")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 x)
555
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2354 (const :format "GTK "
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2355 :sibling-args (:help-echo "\
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2356 The GTK Window System")
93749ba3e629 [xemacs-hg @ 2001-05-21 08:07:13 by yoshiki]
yoshiki
parents: 480
diff changeset
2357 gtk)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 (const :format "PM "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 OS/2 Presentation Manager")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 pm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 (const :format "MSWindows "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 :sibling-args (:help-echo "\
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2364 Microsoft Windows, displays")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 mswindows)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2366 (const :format "MSPrinter "
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 :sibling-args (:help-echo "\
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2368 Microsoft Windows, printers")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2369 msprinter)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 (const :format "TTY%n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 Plain text terminals")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 tty)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 (group :sibling-args (:help-echo "\
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2375 Only match display or printer devices")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2376 (const :format "Output: "
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2377 class)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2378 (checklist :inline t
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2379 :offset 0
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2380 (const :format "Display "
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2381 :sibling-args (:help-echo "\
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2382 Match display devices")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2383 display)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2384 (const :format "Printer%n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2385 :sibling-args (:help-echo "\
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2386 Match printer devices")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2387 printer)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2388 (group :sibling-args (:help-echo "\
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 Only match the frames with the specified color support")
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2390 (const :format "Color support: "
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 (checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 (const :format "Color "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 Match color frames")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 (const :format "Grayscale "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 Match grayscale frames")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 grayscale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 (const :format "Monochrome%n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 Match frames with no color support")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 mono)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 (group :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 Only match frames with the specified intensity")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 (const :format "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 Background brightness: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 background)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 (checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 :offset 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 (const :format "Light "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 Match frames with light backgrounds")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 light)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 (const :format "Dark\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 :sibling-args (:help-echo "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 Match frames with dark backgrounds")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 dark)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 ;;; The `custom-face' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 (defface custom-face-tag-face '((t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 "Face used for face tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 (defcustom custom-face-default-form 'selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 "Default form of displaying face definition."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 :type '(choice (const all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 (const selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 (const lisp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 :group 'custom-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 (define-widget 'custom-face 'custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 "Customize face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 :sample-face 'custom-face-tag-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 :help-echo "Set or reset this face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 :documentation-property '(lambda (face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 (face-doc-string face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 :value-create 'custom-face-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 :action 'custom-face-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 :custom-category 'face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 :custom-form nil ; defaults to value of `custom-face-default-form'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 :custom-set 'custom-face-set
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2446 :custom-pre-save 'custom-face-pre-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 :custom-save 'custom-face-save
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2448 :custom-post-save 'custom-face-post-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 :custom-reset-current 'custom-redraw
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 :custom-reset-saved 'custom-face-reset-saved
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2451 :custom-pre-reset-standard 'custom-face-pre-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 :custom-reset-standard 'custom-face-reset-standard
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2453 :custom-post-reset-standard 'custom-face-post-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 :custom-menu 'custom-face-menu-create)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 (define-widget 'custom-face-all 'editable-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 "An editable list of display specifications and attributes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 :entry-format "%i %d %v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 :insert-button-args '(:help-echo "Insert new display specification here")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 :append-button-args '(:help-echo "Append new display specification here")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 :delete-button-args '(:help-echo "Delete this display specification")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 :args '((group :format "%v" custom-display custom-face-edit)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 (defconst custom-face-all (widget-convert 'custom-face-all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 "Converted version of the `custom-face-all' widget.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 (define-widget 'custom-display-unselected 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 "A display specification that doesn't match the selected display."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 :match 'custom-display-unselected-match)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 (defun custom-display-unselected-match (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 "Non-nil if VALUE is an unselected display specification."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 (not (face-spec-set-match-display value (selected-frame))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 (define-widget 'custom-face-selected 'group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 "Edit the attributes of the selected display in a face specification."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 :args '((repeat :format ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 (group custom-display-unselected sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 (group (sexp :format "") custom-face-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 (repeat :format ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 sexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 (defconst custom-face-selected (widget-convert 'custom-face-selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 "Converted version of the `custom-face-selected' widget.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 (defun custom-face-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 "Create a list of the display specifications for WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 (let ((buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 children
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 (symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 (tag (widget-get widget :tag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 (state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 (begin (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 (is-last (widget-get widget :custom-last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 (prefix (widget-get widget :custom-prefix)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 (unless tag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 (setq tag (prin1-to-string symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 (cond ((eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 (insert prefix (if is-last " `--- " " |--- "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 widget 'custom-browse-face-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 ;; Create tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 (insert tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 (if (eq custom-buffer-style 'face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 (widget-specify-sample widget begin (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 (insert ": "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 ;; Sample.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 (and (not (find-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 ;; XEmacs cannot display uninitialized faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 (make-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 (push (widget-create-child-and-convert widget 'item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 :format "(%{%t%})"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 :sample-face symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 :tag "sample")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 ;; Visibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 :help-echo "Hide or show this face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 (not (eq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 ;; Magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 widget 'custom-magic nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 ;; Update buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 ;; Insert documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 (widget-default-format-handler widget ?h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 ;; The comment field
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 (let* ((comment (get symbol 'face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 (comment-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 widget 'custom-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 :parent widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 :value (or comment ""))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 (widget-put widget :comment-widget comment-widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 (push comment-widget children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 ;; See also.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 (when (eq (widget-get widget :custom-level) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 (custom-add-parent-links widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 (custom-add-see-also widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 ;; Editor.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 (insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 (unless (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 (message "Creating face editor...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 (unless (widget-get widget :custom-form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 (widget-put widget :custom-form custom-face-default-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 (spec (custom-face-get-spec symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 (form (widget-get widget :custom-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 (indent (widget-get widget :indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 (edit (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 (cond ((and (eq form 'selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 (widget-apply custom-face-selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 :match spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 (when indent (insert-char ?\ indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 'custom-face-selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 ((and (not (eq form 'lisp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 (widget-apply custom-face-all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 :match spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 'custom-face-all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 (when indent (insert-char ?\ indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 'sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 :value spec)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 (custom-face-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 (push edit children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 (widget-put widget :children children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 (message "Creating face editor...done"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 (defvar custom-face-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 '(("Set for Current Session" custom-face-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 ("Save for Future Sessions" custom-face-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 ("Reset to Saved" custom-face-reset-saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 (or (get (widget-value widget) 'saved-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 (get (widget-value widget) 'saved-face-comment))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 ("Reset to Standard Setting" custom-face-reset-standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 (get (widget-value widget) 'face-defface-spec)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 ("Add Comment" custom-comment-show custom-comment-invisible-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 ("---" ignore ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 ("Show all display specs" custom-face-edit-all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 (not (eq (widget-get widget :custom-form) 'all))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 ("Just current attributes" custom-face-edit-selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 (not (eq (widget-get widget :custom-form) 'selected))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 ("Show as Lisp expression" custom-face-edit-lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 (not (eq (widget-get widget :custom-form) 'lisp)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 "Alist of actions for the `custom-face' widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 the menu entry, ACTION is the function to call on the widget when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 menu is selected, and FILTER is a predicate which takes a `custom-face'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 widget as an argument, and returns non-nil if ACTION is valid on that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 widget. If FILTER is nil, ACTION is always valid.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 (defun custom-face-edit-selected (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 "Edit selected attributes of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 (widget-put widget :custom-form 'selected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 (defun custom-face-edit-all (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 "Edit all attributes of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 (widget-put widget :custom-form 'all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 (defun custom-face-edit-lisp (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 "Edit the lisp representation of the value of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 (widget-put widget :custom-state 'unknown)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 (widget-put widget :custom-form 'lisp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 (custom-redraw widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 (defun custom-face-state-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 "Set the state of WIDGET."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 (comment (get symbol 'face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 tmp temp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 (widget-put widget :custom-state
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 (cond ((progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 (setq tmp (get symbol 'customized-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 (setq temp (get symbol 'customized-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 (if (equal temp comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 'set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 ((progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 (setq tmp (get symbol 'saved-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 (setq temp (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 (or tmp temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 (if (equal temp comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 'saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 ((get symbol 'face-defface-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 (if (equal comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 'standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 'changed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 'rogue)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 (defun custom-face-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 "Show the menu for `custom-face' WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 Optional EVENT is the location for the menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 (if (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 (custom-toggle-hide widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 (symbol (widget-get widget :value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 (answer (widget-choose (concat "Operation on "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 (custom-unlispify-tag-name symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 (custom-menu-filter custom-face-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 (funcall answer widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 (defun custom-face-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 "Make the face attributes in WIDGET take effect."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 (value (widget-value child))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 (comment (widget-value comment-widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 (put symbol 'customized-face value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 (put symbol 'customized-face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 (put symbol 'face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 (custom-face-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 (custom-redraw-magic widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2696 (defun custom-face-pre-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2697 "Prepare for saving the face being edited by WIDGET."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 (value (widget-value child))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 (comment-widget (widget-get widget :comment-widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 (comment (widget-value comment-widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 (when (equal comment "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 (setq comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 ;; Make the comment invisible by hand if it's empty
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 (set-extent-property (widget-get comment-widget :comment-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 'invisible t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 (put symbol 'saved-face value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 (custom-push-theme 'theme-face symbol 'user 'set value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 (put symbol 'customized-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 (put symbol 'face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 (put symbol 'customized-face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 (put symbol 'saved-face-comment comment)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2715 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2716
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2717 (defun custom-face-post-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2718 "Finish saving the face being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2719 (custom-face-state-set widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2720 (custom-redraw-magic widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2721
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2722 (defun custom-face-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2723 "Save the face being edited by WIDGET."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2724 (custom-face-pre-save widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2725 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2726 (custom-face-post-save widget))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 (defun custom-face-reset-saved (widget)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2729 "Reset the face being edited by WIDGET to its saved value."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 (child (car (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 (value (get symbol 'saved-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 (comment (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 (comment-widget (widget-get widget :comment-widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 (unless (or value comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 (signal 'error (list "No saved value for this face" symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 (put symbol 'customized-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 (put symbol 'customized-face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 (put symbol 'face-comment comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 (widget-value-set child value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 ;; This call manages the comment visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 (widget-value-set comment-widget (or comment ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 (custom-face-state-set widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 (custom-redraw-magic widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2747 ;; This function returns non nil if we need to re-save the options --dv.
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2748 (defun custom-face-pre-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2749 "Prepare for restoring the face edited by WIDGET to its standard
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2750 settings."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 (let* ((symbol (widget-value widget))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2752 (value (get symbol 'face-defface-spec)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 (unless value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 (signal 'error (list "No standard setting for this face" symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 (put symbol 'customized-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 (put symbol 'customized-face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 (put symbol 'saved-face nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 ;; Do not explictly save resets to standards without themes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 (if (null (cdr (get symbol 'theme-face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 (put symbol 'theme-face nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 (put symbol 'saved-face-comment nil)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2764 widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2765 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2766
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2767 (defun custom-face-post-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2768 "Finish restoring the face edited by WIDGET to its standard settings."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2769 (let* ((symbol (widget-value widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2770 (child (car (widget-get widget :children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2771 (value (get symbol 'face-defface-spec))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2772 (comment-widget (widget-get widget :comment-widget)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 (face-spec-set symbol value nil '(custom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 (put symbol 'face-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 (widget-value-set child value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 ;; This call manages the comment visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 (widget-value-set comment-widget "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 (custom-face-state-set widget)
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2779 (custom-redraw-magic widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2780 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2781
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2782 (defun custom-face-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2783 "Restore the face edited by WIDGET to its standard settings."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2784 (when (custom-face-pre-reset-standard widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2785 (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2786 (custom-face-post-reset-standard widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2787
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 ;;; The `face' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 (define-widget 'face 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 "Select and customize a face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 :convert-widget 'widget-value-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 :button-prefix 'widget-push-button-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 :button-suffix 'widget-push-button-suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 :format "%t: %[select face%] %v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 :tag "Face"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 :value 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 :value-create 'widget-face-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 :value-delete 'widget-face-value-delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 :value-get 'widget-value-value-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 :validate 'widget-children-validate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 :action 'widget-face-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 :match (lambda (widget value) (symbolp value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 (defun widget-face-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 ;; Create a `custom-face' child.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 (let* ((symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 (custom-buffer-style 'face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 (child (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 widget 'custom-face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 :custom-level nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 :value symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 (custom-magic-reset child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 (setq custom-options (cons child custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 (widget-put widget :children (list child))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 (defun widget-face-value-delete (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 ;; Remove the child from the options.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 (let ((child (car (widget-get widget :children))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 (setq custom-options (delq child custom-options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 (widget-children-value-delete widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 (defvar face-history nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 "History of entered face names.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 (defun widget-face-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 "Prompt for a face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 (let ((answer (completing-read "Face: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 (mapcar (lambda (face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 (list (symbol-name face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 (face-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 nil nil nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 'face-history)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 (unless (zerop (length answer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 (widget-value-set widget (intern answer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 (widget-apply widget :notify widget event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 (widget-setup))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 ;;; The `hook' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 (define-widget 'hook 'list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 "A emacs lisp hook"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 :value-to-internal (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 (if (symbolp value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 (list value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 :match (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 (or (symbolp value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 (widget-group-match widget value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 :convert-widget 'custom-hook-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 :tag "Hook")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 (defun custom-hook-convert-widget (widget)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
2855 ;; Handle `:options'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 (let* ((options (widget-get widget :options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 (other `(editable-list :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 :entry-format "%i %d%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 (function :format " %v")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 (args (if options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 (list `(checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 ,@(mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 `(function-item ,entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 (list other))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 (widget-put widget :args args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 ;;; The `plist' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 (define-widget 'plist 'list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 "A property list."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 :match (lambda (widget value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 (valid-plist-p value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 :convert-widget 'custom-plist-convert-widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 :tag "Property List")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 ;; #### Should handle options better.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 (defun custom-plist-convert-widget (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 (let* ((options (widget-get widget :options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 (other `(editable-list :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 (group :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 (symbol :format "%t: %v "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 :size 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 :tag "Property")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 (sexp :tag "Value"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 (args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 (if options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 `((checklist :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 ,@(mapcar 'custom-plist-process-option options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 ,other)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 (list other))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 (widget-put widget :args args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 (defun custom-plist-process-option (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 `(group :inline t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 (const :tag "Property"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 :format "%t: %v "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 :size 10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 ,entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 (sexp :tag "Value")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 ;;; The `custom-group-link' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 (define-widget 'custom-group-link 'link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 "Show parent in other window when activated."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 :help-echo 'custom-group-link-help-echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 :action 'custom-group-link-action)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 (defun custom-group-link-help-echo (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 (concat "Create customization buffer for the `"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 (custom-unlispify-tag-name (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 "' group"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 (defun custom-group-link-action (widget &rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 (customize-group (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 ;;; The `custom-group' Widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 (defcustom custom-group-tag-faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 ;; In XEmacs, this ought to play games with font size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 "Face used for group tags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 The first member is used for level 1 groups, the second for level 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 and so forth. The remaining group tags are shown with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 `custom-group-tag-face'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 :type '(repeat face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 (defface custom-group-tag-face-1 '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 (:foreground "pink" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 (:foreground "red" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 (t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 "Face used for group tags.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 (defface custom-group-tag-face '((((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 (background dark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 (:foreground "light blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 (((class color)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 (background light))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 (:foreground "blue" :underline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 (t (:underline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 "Face used for low level group tags."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 :group 'custom-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 (define-widget 'custom-group 'custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 "Customize group."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 :sample-face-get 'custom-group-sample-face-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 :documentation-property 'group-documentation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 :help-echo "Set or reset all members of this group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 :value-create 'custom-group-value-create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 :action 'custom-group-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 :custom-category 'group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 :custom-set 'custom-group-set
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2960 :custom-pre-save 'custom-group-pre-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 :custom-save 'custom-group-save
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2962 :custom-post-save 'custom-group-post-save
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 :custom-reset-current 'custom-group-reset-current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 :custom-reset-saved 'custom-group-reset-saved
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2965 :custom-pre-reset-standard 'custom-group-pre-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 :custom-reset-standard 'custom-group-reset-standard
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
2967 :custom-post-reset-standard 'custom-group-post-reset-standard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 :custom-menu 'custom-group-menu-create)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 (defun custom-group-sample-face-get (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 ;; Use :sample-face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 'custom-group-tag-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 (define-widget 'custom-group-visibility 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 "An indicator and manipulator for hidden group contents."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 :create 'custom-group-visibility-create)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 (defun custom-group-visibility-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 (let ((visible (widget-value widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 (if visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 (insert "--------")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 (widget-default-create widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 (defun custom-group-members (symbol groups-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 "Return SYMBOL's custom group members.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 If GROUPS-ONLY non-nil, return only those members that are groups."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 (if (not groups-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 (get symbol 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 (let (members)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 (dolist (entry (get symbol 'custom-group) (nreverse members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 (when (eq (nth 1 entry) 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 (push entry members))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 (defun custom-group-value-create (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 "Insert a customize group for WIDGET in the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 (let* ((state (widget-get widget :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 (level (widget-get widget :custom-level))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 ;; (indent (widget-get widget :indent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 (prefix (widget-get widget :custom-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 (buttons (widget-get widget :buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 (tag (widget-get widget :tag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 (symbol (widget-value widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 (members (custom-group-members symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 (and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 custom-browse-only-groups))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 (cond ((and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 (eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 (or members (custom-unloaded-widget-p widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 widget 'custom-browse-visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 ;; :tag-glyph "plus"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 :tag "+")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 (insert "-- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 ;; (widget-glyph-insert nil "-- " "horizontal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 ((and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 (zerop (length members)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 (insert "[ ]-- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 ;; (widget-glyph-insert nil "[ ]" "empty")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 ;; (widget-glyph-insert nil "-- " "horizontal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 ((eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 (if (zerop (length members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 (custom-browse-insert-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 (insert "[ ]-- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 ;; (widget-glyph-insert nil "[ ]" "empty")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 ;; (widget-glyph-insert nil "-- " "horizontal")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 (widget-put widget :buttons buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 widget 'custom-browse-visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 ;; :tag-glyph "minus"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 :tag "-")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 (insert "-\\ ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 ;; (widget-glyph-insert nil "-\\ " "top")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 widget 'custom-browse-group-tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 (insert " " tag "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 (message "Creating group...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 (let* ((members (custom-sort-items members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 custom-browse-sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 custom-browse-order-groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 (prefixes (widget-get widget :custom-prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 (custom-prefix-list (custom-prefix-add symbol prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 (extra-prefix (if (widget-get widget :custom-last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 " "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 " | "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 (prefix (concat prefix extra-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 children entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 (while members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 (setq entry (car members)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 members (cdr members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 widget (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 :group widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 :tag (custom-unlispify-tag-name (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 :custom-prefixes custom-prefix-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 :custom-level (1+ level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 :custom-last (null members)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 :value (nth 0 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 :custom-prefix prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 (widget-put widget :children (reverse children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 (message "Creating group...done")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 ;; Nested style.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 ((eq state 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088 ;; Create level indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 (unless (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 (insert-char ?\ (* custom-buffer-indent (1- level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 (insert "-- "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 ;; Create link indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 (when (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 (insert " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 widget 'custom-group-link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 :tag "Open"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 :tag-glyph '("open-up" "open-down")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 (insert " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 ;; Create tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 (let ((begin (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 (insert tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 (widget-specify-sample widget begin (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 (insert " group")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 ;; Create visibility indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 (unless (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 (insert ": ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 widget 'custom-group-visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 :help-echo "Show members of this group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 (not (eq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 (insert " \n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 ;; Create magic button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 widget 'custom-magic nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 ;; Update buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 ;; Insert documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 (if (and (eq custom-buffer-style 'links) (> level 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 (widget-put widget :documentation-indent 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 (widget-default-format-handler widget ?h))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 ;; Nested style.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 (t ;Visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 (custom-load-widget widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 ;; Update members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 (setq members (custom-group-members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 symbol (and (eq custom-buffer-style 'tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 custom-browse-only-groups)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 ;; Add parent groups references above the group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 (if t ;;; This should test that the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 ;;; was made to display a group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 (when (eq level 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 (if (custom-add-parent-links widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 "Go to parent group:")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 (insert "\n"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 ;; Create level indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 (insert-char ?\ (* custom-buffer-indent (1- level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 (insert "/- ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 ;; Create tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 (let ((start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 (insert tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 (widget-specify-sample widget start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 (insert " group: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 ;; Create visibility indicator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 (unless (eq custom-buffer-style 'links)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 (insert "--------")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 (push (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 widget 'visibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 :help-echo "Hide members of this group"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 :action 'custom-toggle-parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 (not (eq state 'hidden)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 (insert " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 ;; Create more dashes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 ;; Use 76 instead of 75 to compensate for the temporary "<"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 ;; added by `widget-insert'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 (insert-char ?- (- 76 (current-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 (* custom-buffer-indent level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 (insert "\\\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 ;; Create magic button.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 (let ((magic (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 widget 'custom-magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 :indent 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 (widget-put widget :custom-magic magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 (push magic buttons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 ;; Update buttons.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 (widget-put widget :buttons buttons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 ;; Insert documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 (widget-default-format-handler widget ?h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 ;; Parent groups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 (if nil ;;; This should test that the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 ;;; was not made to display a group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 (when (eq level 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 (insert-char ?\ custom-buffer-indent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 (custom-add-parent-links widget)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 (custom-add-see-also widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 (make-string (* custom-buffer-indent level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 ?\ ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 ;; Members.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 (message "Creating group...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 (let* ((members (custom-sort-items members
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 custom-buffer-sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 custom-buffer-order-groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 (prefixes (widget-get widget :custom-prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 (custom-prefix-list (custom-prefix-add symbol prefixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 (length (length members))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 (count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 (children (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 (widget-insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 (when (zerop (% count custom-skip-messages))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 'progress
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 (format "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 Creating group members... %2d%%"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 (/ (* 100.0 count) length))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 (incf count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 (widget-create-child-and-convert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 widget (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 :group widget
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 :tag (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 :custom-prefixes custom-prefix-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 :custom-level (1+ level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 :value (nth 0 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 (unless (eq (preceding-char) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 (widget-insert "\n"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 members)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 (message "Creating group magic...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 (mapc 'custom-magic-reset children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 (message "Creating group state...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 (widget-put widget :children children)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 (custom-group-state-update widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 (message "Creating group... done"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 ;; End line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 (insert "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 (insert-char ?\ (* custom-buffer-indent (1- level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 (insert "\\- " (widget-get widget :tag) " group end ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 (insert "/\n")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 (defvar custom-group-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 '(("Set for Current Session" custom-group-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 (eq (widget-get widget :custom-state) 'modified)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 ("Save for Future Sessions" custom-group-save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 (memq (widget-get widget :custom-state) '(modified set))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 ("Reset to Current" custom-group-reset-current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 (memq (widget-get widget :custom-state) '(modified))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 ("Reset to Saved" custom-group-reset-saved
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 (memq (widget-get widget :custom-state) '(modified set))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 ("Reset to standard setting" custom-group-reset-standard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 (lambda (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 (memq (widget-get widget :custom-state) '(modified set saved)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 "Alist of actions for the `custom-group' widget.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 the menu entry, ACTION is the function to call on the widget when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 menu is selected, and FILTER is a predicate which takes a `custom-group'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 widget as an argument, and returns non-nil if ACTION is valid on that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 widget. If FILTER is nil, ACTION is always valid.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 (defun custom-group-action (widget &optional event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 "Show the menu for `custom-group' WIDGET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 Optional EVENT is the location for the menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 (if (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 (custom-toggle-hide widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 (let* ((completion-ignore-case t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 (answer (widget-choose (concat "Operation on "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 (custom-unlispify-tag-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 (widget-get widget :value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 (custom-menu-filter custom-group-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 (if answer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 (funcall answer widget)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 (defun custom-group-set (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 "Set changes in all modified group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 (widget-apply child :custom-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3276 (defun custom-group-pre-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3277 "Prepare for saving all modified group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3278 (let ((children (widget-get widget :children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3279 (mapc (lambda (child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3280 (when (memq (widget-get child :custom-state) '(modified set))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3281 (widget-apply child :custom-pre-save)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3282 children)))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3283
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3284 (defun custom-group-post-save (widget)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 "Save all modified group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 (when (memq (widget-get child :custom-state) '(modified set))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3289 (widget-apply child :custom-post-save)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3292 (defun custom-group-save (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3293 "Save all modified group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3294 (custom-group-pre-save widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3295 (custom-save-all)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3296 (custom-group-post-save widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3297
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 (defun custom-group-reset-current (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 "Reset all modified group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 (when (eq (widget-get child :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 (widget-apply child :custom-reset-current)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 (defun custom-group-reset-saved (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 "Reset all modified or set group members."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 (when (memq (widget-get child :custom-state) '(modified set))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 (widget-apply child :custom-reset-saved)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3314 ;; This function returns non nil when we need to re-save the options --dv.
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3315 (defun custom-group-pre-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3316 "Prepare for resetting all modified, set, or saved group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3317 (let ((children (widget-get widget :children))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3318 must-save)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3319 (mapc (lambda (child)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3320 (when (memq (widget-get child :custom-state)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3321 '(modified set saved))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3322 (and (widget-apply child :custom-pre-reset-standard)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3323 (setq must-save t))))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3324 children)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3325 must-save
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3326 ))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3327
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3328 (defun custom-group-post-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3329 "Finish resetting all modified, set, or saved group members."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 (let ((children (widget-get widget :children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 (mapc (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 (when (memq (widget-get child :custom-state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333 '(modified set saved))
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3334 (widget-apply child :custom-post-reset-standard)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 children)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336
480
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3337 (defun custom-group-reset-standard (widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3338 "Reset all modified, set, or saved group members."
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3339 (when (custom-group-pre-reset-standard widget)
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3340 (custom-save-all))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3341 (custom-group-post-reset-standard widget))
e07227fed94e [xemacs-hg @ 2001-04-23 16:18:04 by didierv]
didierv
parents: 476
diff changeset
3342
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 (defun custom-group-state-update (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 "Update magic."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 (unless (eq (widget-get widget :custom-state) 'hidden)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 (let* ((children (widget-get widget :children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 (states (mapcar (lambda (child)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 (widget-get child :custom-state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 children))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 (magics custom-magic-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 (found 'standard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 (while magics
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 (let ((magic (car (car magics))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 (if (and (not (eq magic 'hidden))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 (memq magic states))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 (setq found magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 magics nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 (setq magics (cdr magics)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 (widget-put widget :custom-state found)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 (custom-magic-reset widget))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 (defun custom-save-delete (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 "Delete the call to SYMBOL form in `custom-file'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 Leave point at the location of the call, or after the last expression."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 (let ((find-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 (auto-mode-alist nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 (set-buffer (find-file-noselect custom-file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 (catch 'found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 (while t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 (let ((sexp (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 (read (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 (end-of-file (throw 'found nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 (when (and (listp sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 (eq (car sexp) symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 (delete-region (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 (backward-sexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 (throw 'found nil))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 (defun custom-save-variables ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 "Save all customized variables in `custom-file'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 (custom-save-delete 'custom-load-themes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 (custom-save-delete 'custom-reset-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 (custom-save-delete 'custom-set-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 (custom-save-loaded-themes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 (custom-save-resets 'theme-value 'custom-reset-variables nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 (let ((standard-output (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 (unless (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 (princ "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 (princ "(custom-set-variables")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3394 (mapatoms (lambda (symbol)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3395 (let ((spec (car-safe (get symbol 'theme-value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 (requests (get symbol 'custom-requests))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 (now (not (or (get symbol 'standard-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 (and (not (boundp symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 (not (eq (get symbol 'force-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 'rogue))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 (comment (get symbol 'saved-variable-comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 (when (or (and spec (eq (car spec) 'user)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3403 (eq (second spec) 'set)) comment
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3404 ;; support non-themed vars
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3405 (and (null spec) (get symbol 'saved-value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 (princ "\n '(")
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 707
diff changeset
3407 (prin1 symbol)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 (princ " ")
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3409 ;; This comment stuff is in the way ####
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 ;; Is (eq (third spec) (car saved-value)) ????
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 ;; (prin1 (third spec))
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 707
diff changeset
3412 ;; XEmacs -- pretty-print value if available
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 707
diff changeset
3413 (if-fboundp 'pp
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 707
diff changeset
3414 (pp (car (get symbol 'saved-value)))
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 707
diff changeset
3415 (prin1 (car (get symbol 'saved-value))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 (when (or now requests comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 (princ (if now " t" " nil")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 (when (or comment requests)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 (princ " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 (prin1 requests))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 (when comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 (princ " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 (prin1 comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 (princ ")")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 (princ ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 (unless (looking-at "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 (princ "\n")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 (defvar custom-save-face-ignoring nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 (defun custom-save-face-internal (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 (let ((theme-spec (car-safe (get symbol 'theme-face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 (comment (get symbol 'saved-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 (now (not (or (get symbol 'face-defface-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435 (and (not (find-face symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 (not (eq (get symbol 'force-face) 'rogue)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 (when (or (and (not (memq symbol custom-save-face-ignoring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 ;; Don't print default face here.
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3439 (or (and theme-spec
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3440 (eq (car theme-spec) 'user)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3441 (eq (second theme-spec) 'set))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3442 ;; cope with non-themed faces
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3443 (and (null theme-spec)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 613
diff changeset
3444 (get symbol 'saved-face)))) comment)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 (princ "\n '(")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 (prin1 symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 (princ " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 (prin1 (get symbol 'saved-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 (if (or comment now)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 (princ (if now " t" " nil")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 (when comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 (princ " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 (prin1 comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 (princ ")"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 (defun custom-save-faces ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 "Save all customized faces in `custom-file'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 (custom-save-delete 'custom-reset-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 (custom-save-delete 'custom-set-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 (custom-save-resets 'theme-face 'custom-reset-faces '(default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 (let ((standard-output (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 (unless (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 (princ "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 (princ "(custom-set-faces")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 ;; The default face must be first, since it affects the others.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467 (custom-save-face-internal 'default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 (let ((custom-save-face-ignoring '(default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 (mapatoms #'custom-save-face-internal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 (princ ")")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 (unless (looking-at "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 (princ "\n")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 (defun custom-save-resets (property setter special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 (let (started-writing ignored-special)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3476 (setq ignored-special ignored-special) ;; suppress byte-compiler warning
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3477 ;; (custom-save-delete setter) Done by caller
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 (let ((standard-output (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 (mapper `(lambda (object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 (let ((spec (car-safe (get object (quote ,property)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 (when (and (not (memq object ignored-special))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 (eq (car spec) 'user)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 (eq (second spec) 'reset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 ;; Do not write reset statements unless necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 (unless started-writing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 (setq started-writing t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 (unless (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 (princ "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 (princ "(")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 (princ (quote ,setter))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 (princ "\n '(")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 (prin1 object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 (princ " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 (prin1 (third spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 (princ ")")))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 (mapc mapper special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 (setq ignored-special special)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 (mapatoms mapper)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 (when started-writing
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3500 (princ ")\n"))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3501 )
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3502
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 (defun custom-save-loaded-themes ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 (let ((themes (reverse (get 'user 'theme-loads-themes)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 (standard-output (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 (when themes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 (unless (bolp) (princ "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 (princ "(custom-load-themes")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 (mapc (lambda (theme)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 (princ "\n '")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 (prin1 theme)) themes)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3513 (princ " )\n"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516 (defun customize-save-customized ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 "Save all user options which have been set in this session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 (mapatoms (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 (let ((face (get symbol 'customized-face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 (value (get symbol 'customized-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 (face-comment (get symbol 'customized-face-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 (variable-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 (get symbol 'customized-variable-comment)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 (when face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 (put symbol 'saved-face face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 (custom-push-theme 'theme-face symbol 'user 'set value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 (put symbol 'customized-face nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 (when value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 (put symbol 'saved-value value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 (custom-push-theme 'theme-value symbol 'user 'set value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 (put symbol 'customized-value nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 (when variable-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 (put symbol 'saved-variable-comment variable-comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 (put symbol 'customized-variable-comment nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 (when face-comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 (put symbol 'saved-face-comment face-comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 (put symbol 'customized-face-comment nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 ;; We really should update all custom buffers here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 (custom-save-all))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 (defun custom-save-all ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 "Save all customizations in `custom-file'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 (let ((inhibit-read-only t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 (custom-save-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 (custom-save-faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 (let ((find-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 (auto-mode-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 (with-current-buffer (find-file-noselect custom-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 (save-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 ;;; The Customize Menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 ;;; Menu support
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 (defun custom-face-menu-create (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 (vector (custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561 `(customize-face ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 (defun custom-variable-menu-create (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 "Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 (let ((type (get symbol 'custom-type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 (unless (listp type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 (setq type (list type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 (if (and type (widget-get type :custom-menu))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 (widget-apply type :custom-menu symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 (vector (custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 `(customize-variable ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 ;; Add checkboxes to boolean variable entries.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 (widget-put (get 'boolean 'widget-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 :custom-menu (lambda (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 `[,(custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 (customize-variable ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 :style toggle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 :selected ,symbol]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 ;; XEmacs can create menus dynamically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 (defun custom-group-menu-create (widget symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 `( ,(custom-unlispify-menu-entry symbol t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 :filter (lambda (&rest junk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 (let ((item (custom-menu-create ',symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 (if (listp item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 (cdr item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 (list item))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 (defun custom-menu-create (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 "Create menu for customization group SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 The menu is in a format applicable to `easy-menu-define'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 (let* ((item (vector (custom-unlispify-menu-entry symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 `(customize-group ',symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 ;; Item is the entry for creating a menu buffer for SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 ;; We may nest, if the menu is not too big.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 (custom-load-symbol symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 (if (< (length (get symbol 'custom-group)) widget-menu-max-size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 ;; The menu is not too big.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 (let ((custom-prefix-list (custom-prefix-add symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 custom-prefix-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 (members (custom-sort-items (get symbol 'custom-group)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 custom-menu-sort-alphabetically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 custom-menu-order-groups)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 ;; Create the menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 `(,(custom-unlispify-menu-entry symbol t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 ,item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 "--"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 ,@(mapcar (lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 (widget-apply (if (listp (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 (nth 1 entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 (list (nth 1 entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 :custom-menu (nth 0 entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 members)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 ;; The menu was too big.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 item)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 (defun customize-menu-create (symbol &optional name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 "Return a customize menu for customization group SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 If optional NAME is given, use that as the name of the menu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 Otherwise the menu will be named `Customize'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 The format is suitable for use with `easy-menu-define'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 (unless name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 (setq name "Customize"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 `(,name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 :filter (lambda (&rest junk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 (cdr (custom-menu-create ',symbol)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 ;;; The Custom Mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 (defvar custom-mode-map nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 "Keymap for `custom-mode'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 (unless custom-mode-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 (setq custom-mode-map (make-sparse-keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 (set-keymap-parents custom-mode-map widget-keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 (suppress-keymap custom-mode-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 (define-key custom-mode-map " " 'scroll-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 (define-key custom-mode-map [delete] 'scroll-down)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 (define-key custom-mode-map "q" 'Custom-buffer-done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 (define-key custom-mode-map "u" 'Custom-goto-parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 (define-key custom-mode-map "n" 'widget-forward)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 (define-key custom-mode-map "p" 'widget-backward))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 (easy-menu-define Custom-mode-menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 custom-mode-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 "Menu used in customization buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 `("Custom"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 ,(customize-menu-create 'customize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 ["Set" Custom-set t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 ["Save" Custom-save t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 ["Reset to Current" Custom-reset-current t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 ["Reset to Saved" Custom-reset-saved t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 ["Reset to Standard Settings" Custom-reset-standard t]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 ["Info" (Info-goto-node "(xemacs)Easy Customization") t]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 (defun Custom-goto-parent ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 "Go to the parent group listed at the top of this buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 If several parents are listed, go to the first of them."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 (if (search-forward "\nGo to parent group: " nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 (let* ((button (get-char-property (point) 'button))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 (parent (downcase (widget-get button :tag))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 (customize-group parent)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 (defcustom custom-mode-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 "Hook called when entering custom-mode."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 :group 'custom-buffer )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 (defun custom-state-buffer-message (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 (message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 "To install your edits, invoke [State] and choose the Set operation")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 (defun custom-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 "Major mode for editing customization buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 The following commands are available:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 Move to next button or editable field. \\[widget-forward]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 Move to previous button or editable field. \\[widget-backward]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 \\<widget-field-keymap>\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 Complete content of editable text field. \\[widget-complete]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 \\<custom-mode-map>\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 Invoke button under point. \\[widget-button-press]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 Set all modifications. \\[Custom-set]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 Make all modifications default. \\[Custom-save]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 Reset all modified options. \\[Custom-reset-current]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 Reset all modified or set options. \\[Custom-reset-saved]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 Reset all options. \\[Custom-reset-standard]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 Entry to this mode calls the value of `custom-mode-hook'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 if that value is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 (kill-all-local-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 (setq major-mode 'custom-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 mode-name "Custom")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 (use-local-map custom-mode-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 (easy-menu-add Custom-mode-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 (make-local-variable 'custom-options)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 (make-local-variable 'widget-documentation-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 (setq widget-documentation-face 'custom-documentation-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 (make-local-variable 'widget-button-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 (setq widget-button-face 'custom-button-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 (make-local-hook 'widget-edit-functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 (run-hooks 'custom-mode-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3718 ;;;###autoload
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3719 (defun custom-migrate-custom-file (new-custom-file-name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3720 "Migrate custom file from home directory."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3721 (mapc 'custom-save-delete
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3722 '(custom-load-themes custom-reset-variables
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3723 custom-set-variables
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3724 custom-set-faces
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3725 custom-reset-faces))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3726 (with-current-buffer (find-file-noselect custom-file)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3727 (save-buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3728 (setq custom-file new-custom-file-name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3729 (custom-save-all))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3730
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 ;;; The End.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 (provide 'cus-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 ;; cus-edit.el ends here