aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorPer Abrahamsen1997-04-12 17:51:31 +0000
committerPer Abrahamsen1997-04-12 17:51:31 +0000
commitbd042c030f6530726313e4ff55065df7e2ee41a9 (patch)
treeabb71fe08c194635b74c71d314bcc23c319790b3 /lisp
parentc5292bc831ae97cd0d99234c039c9309c05af2a6 (diff)
downloademacs-bd042c030f6530726313e4ff55065df7e2ee41a9.tar.gz
emacs-bd042c030f6530726313e4ff55065df7e2ee41a9.zip
Sync with 1.84.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/cus-edit.el548
-rw-r--r--lisp/cus-face.el65
-rw-r--r--lisp/custom.el36
-rw-r--r--lisp/wid-browse.el34
-rw-r--r--lisp/wid-edit.el7
-rw-r--r--lisp/widget.el7
6 files changed, 463 insertions, 234 deletions
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 0327c7aa286..aee2ef02679 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4,7 +4,7 @@
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: help, faces 6;; Keywords: help, faces
7;; Version: 1.71 7;; Version: 1.84
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;;; Commentary: 10;;; Commentary:
@@ -22,6 +22,10 @@
22 :custom-set :custom-save :custom-reset-current :custom-reset-saved 22 :custom-set :custom-save :custom-reset-current :custom-reset-saved
23 :custom-reset-factory) 23 :custom-reset-factory)
24 24
25(put 'custom-define-hook 'custom-type 'hook)
26(put 'custom-define-hook 'factory-value '(nil))
27(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
28
25;;; Customization Groups. 29;;; Customization Groups.
26 30
27(defgroup emacs nil 31(defgroup emacs nil
@@ -202,9 +206,90 @@
202 :link '(url-link :tag "Development Page" 206 :link '(url-link :tag "Development Page"
203 "http://www.dina.kvl.dk/~abraham/custom/") 207 "http://www.dina.kvl.dk/~abraham/custom/")
204 :prefix "custom-" 208 :prefix "custom-"
205 :group 'help 209 :group 'help)
210
211(defgroup custom-faces nil
212 "Faces used by customize."
213 :group 'customize
206 :group 'faces) 214 :group 'faces)
207 215
216(defgroup abbrev-mode nil
217 "Word abbreviations mode."
218 :group 'abbrev)
219
220(defgroup alloc nil
221 "Storage allocation and gc for GNU Emacs Lisp interpreter."
222 :tag "Storage Allocation"
223 :group 'internal)
224
225(defgroup undo nil
226 "Undoing changes in buffers."
227 :group 'editing)
228
229(defgroup modeline nil
230 "Content of the modeline."
231 :group 'environment)
232
233(defgroup fill nil
234 "Indenting and filling text."
235 :group 'editing)
236
237(defgroup editing-basics nil
238 "Most basic editing facilities."
239 :group 'editing)
240
241(defgroup display nil
242 "How characters are displayed in buffers."
243 :group 'environment)
244
245(defgroup execute nil
246 "Executing external commands."
247 :group 'processes)
248
249(defgroup installation nil
250 "The Emacs installation."
251 :group 'environment)
252
253(defgroup dired nil
254 "Directory editing."
255 :group 'environment)
256
257(defgroup limits nil
258 "Internal Emacs limits."
259 :group 'internal)
260
261(defgroup debug nil
262 "Debugging Emacs itself."
263 :group 'development)
264
265(defgroup minibuffer nil
266 "Controling the behaviour of the minibuffer."
267 :group 'environment)
268
269(defgroup keyboard nil
270 "Input from the keyboard."
271 :group 'environment)
272
273(defgroup mouse nil
274 "Input from the mouse."
275 :group 'environment)
276
277(defgroup menu nil
278 "Input from the menus."
279 :group 'environment)
280
281(defgroup auto-save nil
282 "Preventing accidential loss of data."
283 :group 'data)
284
285(defgroup processes-basics nil
286 "Basic stuff dealing with processes."
287 :group 'processes)
288
289(defgroup windows nil
290 "Windows within a frame."
291 :group 'processes)
292
208;;; Utilities. 293;;; Utilities.
209 294
210(defun custom-quote (sexp) 295(defun custom-quote (sexp)
@@ -236,6 +321,23 @@ IF REGEXP is not a string, return it unchanged."
236 (nreverse (cons (substring regexp start) all))) 321 (nreverse (cons (substring regexp start) all)))
237 regexp)) 322 regexp))
238 323
324(defun custom-variable-prompt ()
325 ;; Code stolen from `help.el'.
326 "Prompt for a variable, defaulting to the variable at point.
327Return a list suitable for use in `interactive'."
328 (let ((v (variable-at-point))
329 (enable-recursive-minibuffers t)
330 val)
331 (setq val (completing-read
332 (if v
333 (format "Customize variable (default %s): " v)
334 "Customize variable: ")
335 obarray 'boundp t))
336 (list (if (equal val "")
337 v (intern val)))))
338
339;;; Unlispify.
340
239(defvar custom-prefix-list nil 341(defvar custom-prefix-list nil
240 "List of prefixes that should be ignored by `custom-unlispify'") 342 "List of prefixes that should be ignored by `custom-unlispify'")
241 343
@@ -258,6 +360,10 @@ IF REGEXP is not a string, return it unchanged."
258 (erase-buffer) 360 (erase-buffer)
259 (princ symbol (current-buffer)) 361 (princ symbol (current-buffer))
260 (goto-char (point-min)) 362 (goto-char (point-min))
363 (when (and (eq (get symbol 'custom-type) 'boolean)
364 (re-search-forward "-p\\'" nil t))
365 (replace-match "" t t)
366 (goto-char (point-min)))
261 (let ((prefixes custom-prefix-list) 367 (let ((prefixes custom-prefix-list)
262 prefix) 368 prefix)
263 (while prefixes 369 (while prefixes
@@ -290,62 +396,73 @@ IF REGEXP is not a string, return it unchanged."
290 (concat (symbol-name symbol) "-")) 396 (concat (symbol-name symbol) "-"))
291 prefixes)) 397 prefixes))
292 398
293;;; The Custom Mode. 399;;; Guess.
294 400
295(defvar custom-options nil 401(defcustom custom-guess-name-alist
296 "Customization widgets in the current buffer.") 402 '(("-p\\'" boolean)
297 403 ("-hook\\'" hook)
298(defvar custom-mode-map nil 404 ("-face\\'" face)
299 "Keymap for `custom-mode'.") 405 ("-file\\'" file)
300 406 ("-function\\'" function)
301(unless custom-mode-map 407 ("-functions\\'" (repeat function))
302 (setq custom-mode-map (make-sparse-keymap)) 408 ("-list\\'" (repeat sexp))
303 (set-keymap-parent custom-mode-map widget-keymap) 409 ("-alist\\'" (repeat (cons sexp sexp))))
304 (define-key custom-mode-map "q" 'bury-buffer)) 410 "Alist of (MATCH TYPE).
305 411
306(easy-menu-define custom-mode-menu 412MATCH should be a regexp matching the name of a symbol, and TYPE should
307 custom-mode-map 413be a widget suitable for editing the value of that symbol. The TYPE
308 "Menu used in customization buffers." 414of the first entry where MATCH matches the name of the symbol will be
309 '("Custom" 415used.
310 ["Set" custom-set t] 416
311 ["Save" custom-save t] 417This is used for guessing the type of variables not declared with
312 ["Reset to Current" custom-reset-current t] 418customize."
313 ["Reset to Saved" custom-reset-saved t] 419 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
314 ["Reset to Factory Settings" custom-reset-factory t]
315 ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
316
317(defcustom custom-mode-hook nil
318 "Hook called when entering custom-mode."
319 :type 'hook
320 :group 'customize) 420 :group 'customize)
321 421
322(defun custom-mode () 422(defcustom custom-guess-doc-alist
323 "Major mode for editing customization buffers. 423 '(("\\`\\*?Non-nil " boolean))
424 "Alist of (MATCH TYPE).
324 425
325The following commands are available: 426MATCH should be a regexp matching a documentation string, and TYPE
427should be a widget suitable for editing the value of a variable with
428that documentation string. The TYPE of the first entry where MATCH
429matches the name of the symbol will be used.
326 430
327\\[widget-forward] Move to next button or editable field. 431This is used for guessing the type of variables not declared with
328\\[widget-backward] Move to previous button or editable field. 432customize."
329\\[widget-button-click] Activate button under the mouse pointer. 433 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
330\\[widget-button-press] Activate button under point. 434 :group 'customize)
331\\[custom-set] Set all modifications.
332\\[custom-save] Make all modifications default.
333\\[custom-reset-current] Reset all modified options.
334\\[custom-reset-saved] Reset all modified or set options.
335\\[custom-reset-factory] Reset all options.
336 435
337Entry to this mode calls the value of `custom-mode-hook' 436(defun custom-guess-type (symbol)
338if that value is non-nil." 437 "Guess a widget suitable for editing the value of SYMBOL.
339 (kill-all-local-variables) 438This is done by matching SYMBOL with `custom-guess-name-alist' and
340 (setq major-mode 'custom-mode 439if that fails, the doc string with `custom-guess-doc-alist'."
341 mode-name "Custom") 440 (let ((name (symbol-name symbol))
342 (use-local-map custom-mode-map) 441 (names custom-guess-name-alist)
343 (easy-menu-add custom-mode-menu) 442 current found)
344 (make-local-variable 'custom-options) 443 (while names
345 (run-hooks 'custom-mode-hook)) 444 (setq current (car names)
445 names (cdr names))
446 (when (string-match (nth 0 current) name)
447 (setq found (nth 1 current)
448 names nil)))
449 (unless found
450 (let ((doc (documentation-property symbol 'variable-documentation))
451 (docs custom-guess-doc-alist))
452 (when doc
453 (while docs
454 (setq current (car docs)
455 docs (cdr docs))
456 (when (string-match (nth 0 current) doc)
457 (setq found (nth 1 current)
458 docs nil))))))
459 found))
346 460
347;;; Custom Mode Commands. 461;;; Custom Mode Commands.
348 462
463(defvar custom-options nil
464 "Customization widgets in the current buffer.")
465
349(defun custom-set () 466(defun custom-set ()
350 "Set changes in all modified options." 467 "Set changes in all modified options."
351 (interactive) 468 (interactive)
@@ -430,21 +547,17 @@ when the action is chosen.")
430;;;###autoload 547;;;###autoload
431(defun customize-variable (symbol) 548(defun customize-variable (symbol)
432 "Customize SYMBOL, which must be a variable." 549 "Customize SYMBOL, which must be a variable."
433 (interactive 550 (interactive (custom-variable-prompt))
434 ;; Code stolen from `help.el'.
435 (let ((v (variable-at-point))
436 (enable-recursive-minibuffers t)
437 val)
438 (setq val (completing-read
439 (if v
440 (format "Customize variable (default %s): " v)
441 "Customize variable: ")
442 obarray 'boundp t))
443 (list (if (equal val "")
444 v (intern val)))))
445 (custom-buffer-create (list (list symbol 'custom-variable)))) 551 (custom-buffer-create (list (list symbol 'custom-variable))))
446 552
447;;;###autoload 553;;;###autoload
554(defun customize-variable-other-window (symbol)
555 "Customize SYMBOL, which must be a variable.
556Show the buffer in another window, but don't select it."
557 (interactive (custom-variable-prompt))
558 (custom-buffer-create-other-window (list (list symbol 'custom-variable))))
559
560;;;###autoload
448(defun customize-face (&optional symbol) 561(defun customize-face (&optional symbol)
449 "Customize SYMBOL, which should be a face name or nil. 562 "Customize SYMBOL, which should be a face name or nil.
450If SYMBOL is nil, customize all faces." 563If SYMBOL is nil, customize all faces."
@@ -455,7 +568,10 @@ If SYMBOL is nil, customize all faces."
455 (message "Looking for faces...") 568 (message "Looking for faces...")
456 (mapcar (lambda (symbol) 569 (mapcar (lambda (symbol)
457 (setq found (cons (list symbol 'custom-face) found))) 570 (setq found (cons (list symbol 'custom-face) found)))
458 (face-list)) 571 (nreverse (mapcar 'intern
572 (sort (mapcar 'symbol-name (face-list))
573 'string<))))
574
459 (custom-buffer-create found)) 575 (custom-buffer-create found))
460 (if (stringp symbol) 576 (if (stringp symbol)
461 (setq symbol (intern symbol))) 577 (setq symbol (intern symbol)))
@@ -464,6 +580,19 @@ If SYMBOL is nil, customize all faces."
464 (custom-buffer-create (list (list symbol 'custom-face))))) 580 (custom-buffer-create (list (list symbol 'custom-face)))))
465 581
466;;;###autoload 582;;;###autoload
583(defun customize-face-other-window (&optional symbol)
584 "Show customization buffer for FACE in other window."
585 (interactive (list (completing-read "Customize face: "
586 obarray 'custom-facep)))
587 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
588 ()
589 (if (stringp symbol)
590 (setq symbol (intern symbol)))
591 (unless (symbolp symbol)
592 (error "Should be a symbol %S" symbol))
593 (custom-buffer-create-other-window (list (list symbol 'custom-face)))))
594
595;;;###autoload
467(defun customize-customized () 596(defun customize-customized ()
468 "Customize all already customized user options." 597 "Customize all already customized user options."
469 (interactive) 598 (interactive)
@@ -511,9 +640,24 @@ user-settable."
511OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where 640OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
512SYMBOL is a customization option, and WIDGET is a widget for editing 641SYMBOL is a customization option, and WIDGET is a widget for editing
513that option." 642that option."
514 (message "Creating customization buffer...")
515 (kill-buffer (get-buffer-create "*Customization*")) 643 (kill-buffer (get-buffer-create "*Customization*"))
516 (switch-to-buffer (get-buffer-create "*Customization*")) 644 (switch-to-buffer (get-buffer-create "*Customization*"))
645 (custom-buffer-create-internal options))
646
647(defun custom-buffer-create-other-window (options)
648 "Create a buffer containing OPTIONS.
649OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
650SYMBOL is a customization option, and WIDGET is a widget for editing
651that option."
652 (kill-buffer (get-buffer-create "*Customization*"))
653 (let ((window (selected-window)))
654 (switch-to-buffer-other-window (get-buffer-create "*Customization*"))
655 (custom-buffer-create-internal options)
656 (select-window window)))
657
658
659(defun custom-buffer-create-internal (options)
660 (message "Creating customization buffer...")
517 (custom-mode) 661 (custom-mode)
518 (widget-insert "This is a customization buffer. 662 (widget-insert "This is a customization buffer.
519Push RET or click mouse-2 on the word ") 663Push RET or click mouse-2 on the word ")
@@ -753,7 +897,8 @@ The list should be sorted most significant first."
753 (string :tag "Magic") 897 (string :tag "Magic")
754 face 898 face
755 (string :tag "Description")))) 899 (string :tag "Description"))))
756 :group 'customize) 900 :group 'customize
901 :group 'custom-faces)
757 902
758(defcustom custom-magic-show 'long 903(defcustom custom-magic-show 'long
759 "Show long description of the state of each customization option." 904 "Show long description of the state of each customization option."
@@ -956,22 +1101,27 @@ Change the state of this item."
956 (t 1101 (t
957 (funcall show widget value))))) 1102 (funcall show widget value)))))
958 1103
1104(defvar custom-load-recursion nil
1105 "Hack to avoid recursive dependencies.")
1106
959(defun custom-load-symbol (symbol) 1107(defun custom-load-symbol (symbol)
960 "Load all dependencies for SYMBOL." 1108 "Load all dependencies for SYMBOL."
961 (let ((loads (get symbol 'custom-loads)) 1109 (unless custom-load-recursion
962 load) 1110 (let ((custom-load-recursion t)
963 (while loads 1111 (loads (get symbol 'custom-loads))
964 (setq load (car loads) 1112 load)
965 loads (cdr loads)) 1113 (while loads
966 (cond ((symbolp load) 1114 (setq load (car loads)
967 (condition-case nil 1115 loads (cdr loads))
968 (require load) 1116 (cond ((symbolp load)
969 (error nil))) 1117 (condition-case nil
970 ((assoc load load-history)) 1118 (require load)
971 (t 1119 (error nil)))
972 (condition-case nil 1120 ((assoc load load-history))
973 (load-library load) 1121 (t
974 (error nil))))))) 1122 (condition-case nil
1123 (load-library load)
1124 (error nil))))))))
975 1125
976(defun custom-load-widget (widget) 1126(defun custom-load-widget (widget)
977 "Load all dependencies for WIDGET." 1127 "Load all dependencies for WIDGET."
@@ -981,11 +1131,11 @@ Change the state of this item."
981 1131
982(defface custom-variable-sample-face '((t (:underline t))) 1132(defface custom-variable-sample-face '((t (:underline t)))
983 "Face used for unpushable variable tags." 1133 "Face used for unpushable variable tags."
984 :group 'customize) 1134 :group 'custom-faces)
985 1135
986(defface custom-variable-button-face '((t (:underline t :bold t))) 1136(defface custom-variable-button-face '((t (:underline t :bold t)))
987 "Face used for pushable variable tags." 1137 "Face used for pushable variable tags."
988 :group 'customize) 1138 :group 'custom-faces)
989 1139
990(define-widget 'custom-variable 'custom 1140(define-widget 'custom-variable 'custom
991 "Customize variable." 1141 "Customize variable."
@@ -1003,6 +1153,22 @@ Change the state of this item."
1003 :custom-reset-saved 'custom-variable-reset-saved 1153 :custom-reset-saved 'custom-variable-reset-saved
1004 :custom-reset-factory 'custom-variable-reset-factory) 1154 :custom-reset-factory 'custom-variable-reset-factory)
1005 1155
1156(defun custom-variable-type (symbol)
1157 "Return a widget suitable for editing the value of SYMBOL.
1158If SYMBOL has a `custom-type' property, use that.
1159Otherwise, look up symbol in `custom-guess-type-alist'."
1160 (let* ((type (or (get symbol 'custom-type)
1161 (and (not (get symbol 'factory-value))
1162 (custom-guess-type symbol))
1163 'sexp))
1164 (options (get symbol 'custom-options))
1165 (tmp (if (listp type)
1166 (copy-list type)
1167 (list type))))
1168 (when options
1169 (widget-put tmp :options options))
1170 tmp))
1171
1006(defun custom-variable-value-create (widget) 1172(defun custom-variable-value-create (widget)
1007 "Here is where you edit the variables value." 1173 "Here is where you edit the variables value."
1008 (custom-load-widget widget) 1174 (custom-load-widget widget)
@@ -1011,15 +1177,8 @@ Change the state of this item."
1011 (form (widget-get widget :custom-form)) 1177 (form (widget-get widget :custom-form))
1012 (state (widget-get widget :custom-state)) 1178 (state (widget-get widget :custom-state))
1013 (symbol (widget-get widget :value)) 1179 (symbol (widget-get widget :value))
1014 (options (get symbol 'custom-options))
1015 (child-type (or (get symbol 'custom-type) 'sexp))
1016 (tag (widget-get widget :tag)) 1180 (tag (widget-get widget :tag))
1017 (type (let ((tmp (if (listp child-type) 1181 (type (custom-variable-type symbol))
1018 (copy-list child-type)
1019 (list child-type))))
1020 (when options
1021 (widget-put tmp :options options))
1022 tmp))
1023 (conv (widget-convert type)) 1182 (conv (widget-convert type))
1024 (value (if (default-boundp symbol) 1183 (value (if (default-boundp symbol)
1025 (default-value symbol) 1184 (default-value symbol)
@@ -1162,10 +1321,10 @@ Optional EVENT is the location for the menu."
1162 (goto-char (widget-get val :from)) 1321 (goto-char (widget-get val :from))
1163 (error "%s" (widget-get val :error))) 1322 (error "%s" (widget-get val :error)))
1164 ((eq form 'lisp) 1323 ((eq form 'lisp)
1165 (set symbol (eval (setq val (widget-value child)))) 1324 (set-default symbol (eval (setq val (widget-value child))))
1166 (put symbol 'customized-value (list val))) 1325 (put symbol 'customized-value (list val)))
1167 (t 1326 (t
1168 (set symbol (setq val (widget-value child))) 1327 (set-default symbol (setq val (widget-value child)))
1169 (put symbol 'customized-value (list (custom-quote val))))) 1328 (put symbol 'customized-value (list (custom-quote val)))))
1170 (custom-variable-state-set widget) 1329 (custom-variable-state-set widget)
1171 (custom-redraw-magic widget))) 1330 (custom-redraw-magic widget)))
@@ -1184,12 +1343,12 @@ Optional EVENT is the location for the menu."
1184 (error "%s" (widget-get val :error))) 1343 (error "%s" (widget-get val :error)))
1185 ((eq form 'lisp) 1344 ((eq form 'lisp)
1186 (put symbol 'saved-value (list (widget-value child))) 1345 (put symbol 'saved-value (list (widget-value child)))
1187 (set symbol (eval (widget-value child)))) 1346 (set-default symbol (eval (widget-value child))))
1188 (t 1347 (t
1189 (put symbol 1348 (put symbol
1190 'saved-value (list (custom-quote (widget-value 1349 'saved-value (list (custom-quote (widget-value
1191 child)))) 1350 child))))
1192 (set symbol (widget-value child)))) 1351 (set-default symbol (widget-value child))))
1193 (put symbol 'customized-value nil) 1352 (put symbol 'customized-value nil)
1194 (custom-save-all) 1353 (custom-save-all)
1195 (custom-variable-state-set widget) 1354 (custom-variable-state-set widget)
@@ -1200,7 +1359,7 @@ Optional EVENT is the location for the menu."
1200 (let ((symbol (widget-value widget))) 1359 (let ((symbol (widget-value widget)))
1201 (if (get symbol 'saved-value) 1360 (if (get symbol 'saved-value)
1202 (condition-case nil 1361 (condition-case nil
1203 (set symbol (eval (car (get symbol 'saved-value)))) 1362 (set-default symbol (eval (car (get symbol 'saved-value))))
1204 (error nil)) 1363 (error nil))
1205 (error "No saved value for %s" symbol)) 1364 (error "No saved value for %s" symbol))
1206 (put symbol 'customized-value nil) 1365 (put symbol 'customized-value nil)
@@ -1211,7 +1370,7 @@ Optional EVENT is the location for the menu."
1211 "Restore the factory setting for the variable being edited by WIDGET." 1370 "Restore the factory setting for the variable being edited by WIDGET."
1212 (let ((symbol (widget-value widget))) 1371 (let ((symbol (widget-value widget)))
1213 (if (get symbol 'factory-value) 1372 (if (get symbol 'factory-value)
1214 (set symbol (eval (car (get symbol 'factory-value)))) 1373 (set-default symbol (eval (car (get symbol 'factory-value))))
1215 (error "No factory default for %S" symbol)) 1374 (error "No factory default for %S" symbol))
1216 (put symbol 'customized-value nil) 1375 (put symbol 'customized-value nil)
1217 (when (get symbol 'saved-value) 1376 (when (get symbol 'saved-value)
@@ -1311,7 +1470,7 @@ Match frames with dark backgrounds.")
1311 1470
1312(defface custom-face-tag-face '((t (:underline t))) 1471(defface custom-face-tag-face '((t (:underline t)))
1313 "Face used for face tags." 1472 "Face used for face tags."
1314 :group 'customize) 1473 :group 'custom-faces)
1315 1474
1316(define-widget 'custom-face 'custom 1475(define-widget 'custom-face 'custom
1317 "Customize face." 1476 "Customize face."
@@ -1613,7 +1772,7 @@ The first member is used for level 1 groups, the second for level 2,
1613and so forth. The remaining group tags are shown with 1772and so forth. The remaining group tags are shown with
1614`custom-group-tag-face'." 1773`custom-group-tag-face'."
1615 :type '(repeat face) 1774 :type '(repeat face)
1616 :group 'customize) 1775 :group 'custom-faces)
1617 1776
1618(defface custom-group-tag-face-1 '((((class color) 1777(defface custom-group-tag-face-1 '((((class color)
1619 (background dark)) 1778 (background dark))
@@ -1632,7 +1791,7 @@ and so forth. The remaining group tags are shown with
1632 (:foreground "blue" :underline t)) 1791 (:foreground "blue" :underline t))
1633 (t (:underline t))) 1792 (t (:underline t)))
1634 "Face used for low level group tags." 1793 "Face used for low level group tags."
1635 :group 'customize) 1794 :group 'custom-faces)
1636 1795
1637(define-widget 'custom-group 'custom 1796(define-widget 'custom-group 'custom
1638 "Customize group." 1797 "Customize group."
@@ -1835,9 +1994,21 @@ Leave point at the location of the call, or after the last expression."
1835 (unless (bolp) 1994 (unless (bolp)
1836 (princ "\n")) 1995 (princ "\n"))
1837 (princ "(custom-set-faces") 1996 (princ "(custom-set-faces")
1997 (let ((value (get 'default 'saved-face)))
1998 ;; The default face must be first, since it affects the others.
1999 (when value
2000 (princ "\n '(default ")
2001 (prin1 value)
2002 (if (or (get 'default 'factory-face)
2003 (and (not (custom-facep 'default))
2004 (not (get 'default 'force-face))))
2005 (princ ")")
2006 (princ " t)"))))
1838 (mapatoms (lambda (symbol) 2007 (mapatoms (lambda (symbol)
1839 (let ((value (get symbol 'saved-face))) 2008 (let ((value (get symbol 'saved-face)))
1840 (when value 2009 (when (and (not (eq symbol 'default))
2010 ;; Don't print default face here.
2011 value)
1841 (princ "\n '(") 2012 (princ "\n '(")
1842 (princ symbol) 2013 (princ symbol)
1843 (princ " ") 2014 (princ " ")
@@ -1862,10 +2033,43 @@ Leave point at the location of the call, or after the last expression."
1862 2033
1863;;; The Customize Menu. 2034;;; The Customize Menu.
1864 2035
1865(defcustom custom-menu-nesting 2 2036;;; Menu support
1866 "Maximum nesting in custom menus." 2037
1867 :type 'integer 2038(unless (string-match "XEmacs" emacs-version)
1868 :group 'customize) 2039 (defconst custom-help-menu '("Customize"
2040 ["Update menu..." custom-menu-update t]
2041 ["Group..." customize t]
2042 ["Variable..." customize-variable t]
2043 ["Face..." customize-face t]
2044 ["Saved..." customize-customized t]
2045 ["Apropos..." customize-apropos t])
2046 ;; This menu should be identical to the one defined in `menu-bar.el'.
2047 "Customize menu")
2048
2049 (defun custom-menu-reset ()
2050 "Reset customize menu."
2051 (remove-hook 'custom-define-hook 'custom-menu-reset)
2052 (define-key global-map [menu-bar help-menu customize-menu]
2053 (cons (car custom-help-menu)
2054 (easy-menu-create-keymaps (car custom-help-menu)
2055 (cdr custom-help-menu)))))
2056
2057 (defun custom-menu-update (event)
2058 "Update customize menu."
2059 (interactive "e")
2060 (add-hook 'custom-define-hook 'custom-menu-reset)
2061 (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
2062 (menu `(,(car custom-help-menu)
2063 ,emacs
2064 ,@(cdr (cdr custom-help-menu)))))
2065 (let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
2066 (define-key global-map [menu-bar help-menu customize-menu]
2067 (cons (car menu) map)))))
2068
2069 (defcustom custom-menu-nesting 2
2070 "Maximum nesting in custom menus."
2071 :type 'integer
2072 :group 'customize))
1869 2073
1870(defun custom-face-menu-create (widget symbol) 2074(defun custom-face-menu-create (widget symbol)
1871 "Ignoring WIDGET, create a menu entry for customization face SYMBOL." 2075 "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
@@ -1884,6 +2088,7 @@ Leave point at the location of the call, or after the last expression."
1884 `(custom-buffer-create '((,symbol custom-variable))) 2088 `(custom-buffer-create '((,symbol custom-variable)))
1885 t)))) 2089 t))))
1886 2090
2091;; Add checkboxes to boolean variable entries.
1887(widget-put (get 'boolean 'widget-type) 2092(widget-put (get 'boolean 'widget-type)
1888 :custom-menu (lambda (widget symbol) 2093 :custom-menu (lambda (widget symbol)
1889 (vector (custom-unlispify-menu-entry symbol) 2094 (vector (custom-unlispify-menu-entry symbol)
@@ -1906,17 +2111,15 @@ Leave point at the location of the call, or after the last expression."
1906 (let ((custom-menu-nesting (1- custom-menu-nesting))) 2111 (let ((custom-menu-nesting (1- custom-menu-nesting)))
1907 (custom-menu-create symbol)))) 2112 (custom-menu-create symbol))))
1908 2113
1909(defun custom-menu-create (symbol &optional name) 2114;;;###autoload
2115(defun custom-menu-create (symbol)
1910 "Create menu for customization group SYMBOL. 2116 "Create menu for customization group SYMBOL.
1911If optional NAME is given, use that as the name of the menu.
1912Otherwise make up a name from SYMBOL.
1913The menu is in a format applicable to `easy-menu-define'." 2117The menu is in a format applicable to `easy-menu-define'."
1914 (unless name 2118 (let* ((item (vector (custom-unlispify-menu-entry symbol)
1915 (setq name (custom-unlispify-menu-entry symbol))) 2119 `(custom-buffer-create '((,symbol custom-group)))
1916 (let ((item (vector name 2120 t)))
1917 `(custom-buffer-create '((,symbol custom-group))) 2121 (if (and (or (not (boundp 'custom-menu-nesting))
1918 t))) 2122 (>= custom-menu-nesting 0))
1919 (if (and (>= custom-menu-nesting 0)
1920 (< (length (get symbol 'custom-group)) widget-menu-max-size)) 2123 (< (length (get symbol 'custom-group)) widget-menu-max-size))
1921 (let ((custom-prefix-list (custom-prefix-add symbol 2124 (let ((custom-prefix-list (custom-prefix-add symbol
1922 custom-prefix-list))) 2125 custom-prefix-list)))
@@ -1933,58 +2136,77 @@ The menu is in a format applicable to `easy-menu-define'."
1933 item))) 2136 item)))
1934 2137
1935;;;###autoload 2138;;;###autoload
1936(defun custom-menu-update (event) 2139(defun customize-menu-create (symbol &optional name)
1937 "Update customize menu." 2140 "Return a customize menu for customization group SYMBOL.
1938 (interactive "e") 2141If optional NAME is given, use that as the name of the menu.
1939 (add-hook 'custom-define-hook 'custom-menu-reset) 2142Otherwise the menu will be named `Customize'.
1940 (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs)) 2143The format is suitable for use with `easy-menu-define'."
1941 (menu `(,(car custom-help-menu) 2144 (unless name
1942 ,emacs 2145 (setq name "Customize"))
1943 ,@(cdr (cdr custom-help-menu))))) 2146 (if (string-match "XEmacs" emacs-version)
1944 (let ((map (easy-menu-create-keymaps (car menu) (cdr menu)))) 2147 ;; We can delay it under XEmacs.
1945 (define-key global-map [menu-bar help-menu customize-menu] 2148 `(,name
1946 (cons (car menu) map))))) 2149 :filter (lambda (&rest junk)
1947 2150 (cdr (custom-menu-create ',symbol))))
1948;;; Dependencies. 2151 ;; But we must create it now under Emacs.
2152 (cons name (cdr (custom-menu-create symbol)))))
1949 2153
1950;;;###autoload 2154;;; The Custom Mode.
1951(defun custom-make-dependencies () 2155
1952 "Batch function to extract custom dependencies from .el files. 2156(defvar custom-mode-map nil
1953Usage: emacs -batch *.el -f custom-make-dependencies > deps.el" 2157 "Keymap for `custom-mode'.")
1954 (let ((buffers (buffer-list))) 2158
1955 (while buffers 2159(unless custom-mode-map
1956 (set-buffer (car buffers)) 2160 (setq custom-mode-map (make-sparse-keymap))
1957 (setq buffers (cdr buffers)) 2161 (set-keymap-parent custom-mode-map widget-keymap)
1958 (let ((file (buffer-file-name))) 2162 (define-key custom-mode-map "q" 'bury-buffer))
1959 (when (and file (string-match "\\`\\(.*\\)\\.el\\'" file)) 2163
1960 (goto-char (point-min)) 2164(easy-menu-define custom-mode-customize-menu
1961 (condition-case nil 2165 custom-mode-map
1962 (let ((name (file-name-nondirectory (match-string 1 file)))) 2166 "Menu used in customization buffers."
1963 (while t 2167 (customize-menu-create 'customize))
1964 (let ((expr (read (current-buffer)))) 2168
1965 (when (and (listp expr) 2169(easy-menu-define custom-mode-menu
1966 (memq (car expr) '(defcustom defface defgroup))) 2170 custom-mode-map
1967 (eval expr) 2171 "Menu used in customization buffers."
1968 (put (nth 1 expr) 'custom-where name))))) 2172 `("Custom"
1969 (error nil)))))) 2173 ["Set" custom-set t]
1970 (mapatoms (lambda (symbol) 2174 ["Save" custom-save t]
1971 (let ((members (get symbol 'custom-group)) 2175 ["Reset to Current" custom-reset-current t]
1972 item where found) 2176 ["Reset to Saved" custom-reset-saved t]
1973 (when members 2177 ["Reset to Factory Settings" custom-reset-factory t]
1974 (princ "(put '") 2178 ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
1975 (princ symbol) 2179
1976 (princ " 'custom-loads '(") 2180(defcustom custom-mode-hook nil
1977 (while members 2181 "Hook called when entering custom-mode."
1978 (setq item (car (car members)) 2182 :type 'hook
1979 members (cdr members) 2183 :group 'customize)
1980 where (get item 'custom-where)) 2184
1981 (unless (or (null where) 2185(defun custom-mode ()
1982 (member where found)) 2186 "Major mode for editing customization buffers.
1983 (when found 2187
1984 (princ " ")) 2188The following commands are available:
1985 (prin1 where) 2189
1986 (push where found))) 2190Move to next button or editable field. \\[widget-forward]
1987 (princ "))\n")))))) 2191Move to previous button or editable field. \\[widget-backward]
2192Activate button under the mouse pointer. \\[widget-button-click]
2193Activate button under point. \\[widget-button-press]
2194Set all modifications. \\[custom-set]
2195Make all modifications default. \\[custom-save]
2196Reset all modified options. \\[custom-reset-current]
2197Reset all modified or set options. \\[custom-reset-saved]
2198Reset all options. \\[custom-reset-factory]
2199
2200Entry to this mode calls the value of `custom-mode-hook'
2201if that value is non-nil."
2202 (kill-all-local-variables)
2203 (setq major-mode 'custom-mode
2204 mode-name "Custom")
2205 (use-local-map custom-mode-map)
2206 (easy-menu-add custom-mode-customize-menu)
2207 (easy-menu-add custom-mode-menu)
2208 (make-local-variable 'custom-options)
2209 (run-hooks 'custom-mode-hook))
1988 2210
1989;;; The End. 2211;;; The End.
1990 2212
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index c0d64a8ecfb..952171ca4d0 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -4,7 +4,7 @@
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: help, faces 6;; Keywords: help, faces
7;; Version: 1.71 7;; Version: 1.84
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;;; Commentary: 10;;; Commentary:
@@ -39,7 +39,7 @@
39 39
40(eval-and-compile 40(eval-and-compile
41 (unless (fboundp 'frame-property) 41 (unless (fboundp 'frame-property)
42 ;; XEmacs function missing in Emacs 19.34. 42 ;; XEmacs function missing in Emacs.
43 (defun frame-property (frame property &optional default) 43 (defun frame-property (frame property &optional default)
44 "Return FRAME's value for property PROPERTY." 44 "Return FRAME's value for property PROPERTY."
45 (or (cdr (assq property (frame-parameters frame))) 45 (or (cdr (assq property (frame-parameters frame)))
@@ -49,44 +49,13 @@
49 ;; XEmacs function missing in Emacs. 49 ;; XEmacs function missing in Emacs.
50 (defun face-doc-string (face) 50 (defun face-doc-string (face)
51 "Get the documentation string for FACE." 51 "Get the documentation string for FACE."
52 (get face 'face-doc-string))) 52 (get face 'face-documentation)))
53 53
54 (unless (fboundp 'set-face-doc-string) 54 (unless (fboundp 'set-face-doc-string)
55 ;; XEmacs function missing in Emacs. 55 ;; XEmacs function missing in Emacs.
56 (defun set-face-doc-string (face string) 56 (defun set-face-doc-string (face string)
57 "Set the documentation string for FACE to STRING." 57 "Set the documentation string for FACE to STRING."
58 (put face 'face-doc-string string))) 58 (put face 'face-documentation string))))
59
60 (when (and (not (fboundp 'set-face-stipple))
61 (fboundp 'set-face-background-pixmap))
62 ;; Emacs function missing in XEmacs 19.15.
63 (defun set-face-stipple (face pixmap &optional frame)
64 ;; Written by Kyle Jones.
65 "Change the stipple pixmap of face FACE to PIXMAP.
66PIXMAP should be a string, the name of a file of pixmap data.
67The directories listed in the `x-bitmap-file-path' variable are searched.
68
69Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
70where WIDTH and HEIGHT are the size in pixels,
71and DATA is a string, containing the raw bits of the bitmap.
72
73If the optional FRAME argument is provided, change only
74in that frame; otherwise change each frame."
75 (while (not (find-face face))
76 (setq face (signal 'wrong-type-argument (list 'facep face))))
77 (while (cond ((stringp pixmap)
78 (unless (file-readable-p pixmap)
79 (setq pixmap (vector 'xbm ':file pixmap)))
80 nil)
81 ((and (consp pixmap) (= (length pixmap) 3))
82 (setq pixmap (vector 'xbm ':data pixmap))
83 nil)
84 (t t))
85 (setq pixmap (signal 'wrong-type-argument
86 (list 'stipple-pixmap-p pixmap))))
87 (while (and frame (not (framep frame)))
88 (setq frame (signal 'wrong-type-argument (list 'framep frame))))
89 (set-face-background-pixmap face pixmap frame))))
90 59
91(unless (fboundp 'x-color-values) 60(unless (fboundp 'x-color-values)
92 ;; Emacs function missing in XEmacs 19.14. 61 ;; Emacs function missing in XEmacs 19.14.
@@ -410,7 +379,7 @@ If FRAME is nil, use the default face."
410 "Return the size of the font of FACE as a string." 379 "Return the size of the font of FACE as a string."
411 (let* ((font (apply 'custom-face-font-name face args)) 380 (let* ((font (apply 'custom-face-font-name face args))
412 (fontobj (font-create-object font))) 381 (fontobj (font-create-object font)))
413 (format "%d" (font-size fontobj)))) 382 (format "%s" (font-size fontobj))))
414 383
415 (defun custom-set-face-font-family (face family &rest args) 384 (defun custom-set-face-font-family (face family &rest args)
416 "Set the font of FACE to FAMILY." 385 "Set the font of FACE to FAMILY."
@@ -425,17 +394,23 @@ If FRAME is nil, use the default face."
425 (fontobj (font-create-object font))) 394 (fontobj (font-create-object font)))
426 (font-family fontobj))) 395 (font-family fontobj)))
427 396
428 (nconc custom-face-attributes 397 (setq custom-face-attributes
429 '((:family (editable-field :format "Font Family: %v" 398 (append '((:family (editable-field :format "Font Family: %v"
430 :help-echo "\ 399 :help-echo "\
431Name of font family to use (e.g. times).") 400Name of font family to use (e.g. times).")
432 custom-set-face-font-family 401 custom-set-face-font-family
433 custom-face-font-family) 402 custom-face-font-family)
434 (:size (editable-field :format "Size: %v" 403 (:size (editable-field :format "Size: %v"
435 :help-echo "\ 404 :help-echo "\
436Text size (e.g. 9pt or 2mm).") 405Text size (e.g. 9pt or 2mm).")
437 custom-set-face-font-size 406 custom-set-face-font-size
438 custom-face-font-size)))) 407 custom-face-font-size)
408 (:strikethru (toggle :format "Strikethru: %[%v%]\n"
409 :help-echo "\
410Control whether the text should be strikethru.")
411 set-face-strikethru-p
412 face-strikethru-p))
413 custom-face-attributes)))
439 414
440;;; Frames. 415;;; Frames.
441 416
diff --git a/lisp/custom.el b/lisp/custom.el
index 57026fc8f4a..4e4cde95d9e 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -4,7 +4,7 @@
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: help, faces 6;; Keywords: help, faces
7;; Version: 1.71 7;; Version: 1.84
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;;; Commentary: 10;;; Commentary:
@@ -23,16 +23,26 @@
23 23
24(define-widget-keywords :prefix :tag :load :link :options :type :group) 24(define-widget-keywords :prefix :tag :load :link :options :type :group)
25 25
26(defvar custom-define-hook nil
27 ;; Customize information for this option is in `cus-edit.el'.
28 "Hook called after defining each customize option.")
29
26;;; The `defcustom' Macro. 30;;; The `defcustom' Macro.
27 31
28(defun custom-declare-variable (symbol value doc &rest args) 32(defun custom-declare-variable (symbol value doc &rest args)
29 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." 33 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
30 (unless (and (default-boundp symbol) 34 ;; Bind this variable unless it already is bound.
31 (not (get symbol 'saved-value))) 35 (unless (default-boundp symbol)
36 ;; Use the saved value if it exists, otherwise the factory setting.
32 (set-default symbol (if (get symbol 'saved-value) 37 (set-default symbol (if (get symbol 'saved-value)
33 (eval (car (get symbol 'saved-value))) 38 (eval (car (get symbol 'saved-value)))
34 (eval value)))) 39 (eval value))))
40 ;; Remember the factory setting.
35 (put symbol 'factory-value (list value)) 41 (put symbol 'factory-value (list value))
42 ;; Maybe this option was rogue in an earlier version. It no longer is.
43 (when (get symbol 'force-value)
44 ;; It no longer is.
45 (put symbol 'force-value nil))
36 (when doc 46 (when doc
37 (put symbol 'variable-documentation doc)) 47 (put symbol 'variable-documentation doc))
38 (while args 48 (while args
@@ -262,23 +272,23 @@ the default value for the SYMBOL."
262 (value (nth 1 entry)) 272 (value (nth 1 entry))
263 (now (nth 2 entry))) 273 (now (nth 2 entry)))
264 (put symbol 'saved-value (list value)) 274 (put symbol 'saved-value (list value))
265 (when now 275 (cond (now
266 (put symbol 'force-value t) 276 ;; Rogue variable, set it now.
267 (set-default symbol (eval value))) 277 (put symbol 'force-value t)
278 (set-default symbol (eval value)))
279 ((default-boundp symbol)
280 ;; Something already set this, overwrite it.
281 (set-default symbol (eval value))))
268 (setq args (cdr args))) 282 (setq args (cdr args)))
269 ;; Old format, a plist of SYMBOL VALUE pairs. 283 ;; Old format, a plist of SYMBOL VALUE pairs.
284 (message "Warning: old format `custom-set-variables'")
285 (ding)
286 (sit-for 2)
270 (let ((symbol (nth 0 args)) 287 (let ((symbol (nth 0 args))
271 (value (nth 1 args))) 288 (value (nth 1 args)))
272 (put symbol 'saved-value (list value))) 289 (put symbol 'saved-value (list value)))
273 (setq args (cdr (cdr args))))))) 290 (setq args (cdr (cdr args)))))))
274 291
275;;; Meta Customization
276
277(defcustom custom-define-hook nil
278 "Hook called after defining each customize option."
279 :group 'customize
280 :type 'hook)
281
282;;; The End. 292;;; The End.
283 293
284(provide 'custom) 294(provide 'custom)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index d90836c05c4..f656a3b9020 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -4,7 +4,7 @@
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: extensions 6;; Keywords: extensions
7;; Version: 1.71 7;; Version: 1.84
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;;; Commentary: 10;;; Commentary:
@@ -29,7 +29,13 @@
29 29
30(unless widget-browse-mode-map 30(unless widget-browse-mode-map
31 (setq widget-browse-mode-map (make-sparse-keymap)) 31 (setq widget-browse-mode-map (make-sparse-keymap))
32 (set-keymap-parent widget-browse-mode-map widget-keymap)) 32 (set-keymap-parent widget-browse-mode-map widget-keymap)
33 (define-key widget-browse-mode-map "q" 'bury-buffer))
34
35(easy-menu-define widget-browse-mode-customize-menu
36 widget-browse-mode-map
37 "Menu used in widget browser buffers."
38 (customize-menu-create 'widgets))
33 39
34(easy-menu-define widget-browse-mode-menu 40(easy-menu-define widget-browse-mode-menu
35 widget-browse-mode-map 41 widget-browse-mode-map
@@ -59,6 +65,7 @@ if that value is non-nil."
59 (setq major-mode 'widget-browse-mode 65 (setq major-mode 'widget-browse-mode
60 mode-name "Widget") 66 mode-name "Widget")
61 (use-local-map widget-browse-mode-map) 67 (use-local-map widget-browse-mode-map)
68 (easy-menu-add widget-browse-mode-customize-menu)
62 (easy-menu-add widget-browse-mode-menu) 69 (easy-menu-add widget-browse-mode-menu)
63 (run-hooks 'widget-browse-mode-hook)) 70 (run-hooks 'widget-browse-mode-hook))
64 71
@@ -82,6 +89,7 @@ if that value is non-nil."
82 89
83(defvar widget-browse-history nil) 90(defvar widget-browse-history nil)
84 91
92;;;###autoload
85(defun widget-browse (widget) 93(defun widget-browse (widget)
86 "Create a widget browser for WIDGET." 94 "Create a widget browser for WIDGET."
87 (interactive (list (completing-read "Widget: " 95 (interactive (list (completing-read "Widget: "
@@ -106,11 +114,11 @@ if that value is non-nil."
106 (widget-browse-mode) 114 (widget-browse-mode)
107 115
108 ;; Quick way to get out. 116 ;; Quick way to get out.
109 (widget-create 'push-button 117;; (widget-create 'push-button
110 :action (lambda (widget &optional event) 118;; :action (lambda (widget &optional event)
111 (bury-buffer)) 119;; (bury-buffer))
112 "Quit") 120;; "Quit")
113 (widget-insert "\n") 121;; (widget-insert "\n")
114 122
115 ;; Top text indicating whether it is a class or object browser. 123 ;; Top text indicating whether it is a class or object browser.
116 (if (listp widget) 124 (if (listp widget)
@@ -145,6 +153,18 @@ if that value is non-nil."
145 (widget-setup) 153 (widget-setup)
146 (goto-char (point-min))) 154 (goto-char (point-min)))
147 155
156;;;###autoload
157(defun widget-browse-other-window (&optional widget)
158 "Show widget browser for WIDGET in other window."
159 (interactive)
160 (let ((window (selected-window)))
161 (switch-to-buffer-other-window "*Browse Widget*")
162 (if widget
163 (widget-browse widget)
164 (call-interactively 'widget-browse))
165 (select-window window)))
166
167
148;;; The `widget-browse' Widget. 168;;; The `widget-browse' Widget.
149 169
150(define-widget 'widget-browse 'push-button 170(define-widget 'widget-browse 'push-button
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 283981d42f4..e7985c5bc8f 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4,7 +4,7 @@
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: extensions 6;; Keywords: extensions
7;; Version: 1.71 7;; Version: 1.84
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;;; Commentary: 10;;; Commentary:
@@ -1238,13 +1238,14 @@ With optional ARG, move across that many fields."
1238(define-widget 'push-button 'item 1238(define-widget 'push-button 'item
1239 "A pushable button." 1239 "A pushable button."
1240 :value-create 'widget-push-button-value-create 1240 :value-create 'widget-push-button-value-create
1241 :text-format "[%s]"
1241 :format "%[%v%]") 1242 :format "%[%v%]")
1242 1243
1243(defun widget-push-button-value-create (widget) 1244(defun widget-push-button-value-create (widget)
1244 ;; Insert text representing the `on' and `off' states. 1245 ;; Insert text representing the `on' and `off' states.
1245 (let* ((tag (or (widget-get widget :tag) 1246 (let* ((tag (or (widget-get widget :tag)
1246 (widget-get widget :value))) 1247 (widget-get widget :value)))
1247 (text (concat "[" tag "]")) 1248 (text (format (widget-get widget :text-format) tag))
1248 (gui (cdr (assoc tag widget-push-button-cache)))) 1249 (gui (cdr (assoc tag widget-push-button-cache))))
1249 (if (and (fboundp 'make-gui-button) 1250 (if (and (fboundp 'make-gui-button)
1250 (fboundp 'make-glyph) 1251 (fboundp 'make-glyph)
@@ -2374,7 +2375,7 @@ It will read a directory name from the minibuffer when activated."
2374(defun widget-vector-match (widget value) 2375(defun widget-vector-match (widget value)
2375 (and (vectorp value) 2376 (and (vectorp value)
2376 (widget-group-match widget 2377 (widget-group-match widget
2377 (widget-apply :value-to-internal widget value)))) 2378 (widget-apply widget :value-to-internal value))))
2378 2379
2379(define-widget 'cons 'group 2380(define-widget 'cons 'group
2380 "A cons-cell." 2381 "A cons-cell."
diff --git a/lisp/widget.el b/lisp/widget.el
index 4e1f2ca804c..7acd239578b 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -4,7 +4,7 @@
4;; 4;;
5;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6;; Keywords: help, extensions, faces, hypermedia 6;; Keywords: help, extensions, faces, hypermedia
7;; Version: 1.71 7;; Version: 1.84
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;;; Commentary: 10;;; Commentary:
@@ -27,8 +27,8 @@
27 (set (car keywords) (car keywords))) 27 (set (car keywords) (car keywords)))
28 (setq keywords (cdr keywords))))))) 28 (setq keywords (cdr keywords)))))))
29 29
30(define-widget-keywords :deactivate :active :inactive :activate 30(define-widget-keywords :text-format :deactivate :active :inactive
31 :sibling-args :delete-button-args 31 :activate :sibling-args :delete-button-args
32 :insert-button-args :append-button-args :button-args 32 :insert-button-args :append-button-args :button-args
33 :tag-glyph :off-glyph :on-glyph :valid-regexp 33 :tag-glyph :off-glyph :on-glyph :valid-regexp
34 :secret :sample-face :sample-face-get :case-fold :widget-doc 34 :secret :sample-face :sample-face-get :case-fold :widget-doc
@@ -50,6 +50,7 @@
50 (autoload 'widget-create "wid-edit") 50 (autoload 'widget-create "wid-edit")
51 (autoload 'widget-insert "wid-edit") 51 (autoload 'widget-insert "wid-edit")
52 (autoload 'widget-browse "wid-browse" nil t) 52 (autoload 'widget-browse "wid-browse" nil t)
53 (autoload 'widget-browse-other-window "wid-browse" nil t)
53 (autoload 'widget-browse-at "wid-browse" nil t)) 54 (autoload 'widget-browse-at "wid-browse" nil t))
54 55
55(defun define-widget (name class doc &rest args) 56(defun define-widget (name class doc &rest args)