Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-edit.el @ 136:b980b6286996 r20-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b2
author cvs
date Mon, 13 Aug 2007 09:31:12 +0200
parents 34a5b81f86ba
children 538048ae2ab8
comparison
equal deleted inserted replaced
135:4636a6841cd6 136:b980b6286996
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
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.89 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:
11 ;; 11 ;;
12 ;; This file implements the code to create and edit customize buffers.
13 ;;
14 ;; See `custom.el'. 12 ;; See `custom.el'.
15 13
16 ;;; Code: 14 ;;; Code:
17 15
18 (require 'cus-face) 16 (require 'cus-face)
19 (require 'wid-edit) 17 (require 'wid-edit)
20 (require 'easymenu) 18 (require 'easymenu)
21
22 (condition-case nil
23 (require 'cus-load)
24 (error nil))
25 19
26 (define-widget-keywords :custom-prefixes :custom-menu :custom-show 20 (define-widget-keywords :custom-prefixes :custom-menu :custom-show
27 :custom-magic :custom-state :custom-level :custom-form 21 :custom-magic :custom-state :custom-level :custom-form
28 :custom-set :custom-save :custom-reset-current :custom-reset-saved 22 :custom-set :custom-save :custom-reset-current :custom-reset-saved
29 :custom-reset-factory) 23 :custom-reset-factory)
339 (format "Customize variable (default %s): " v) 333 (format "Customize variable (default %s): " v)
340 "Customize variable: ") 334 "Customize variable: ")
341 obarray 'boundp t)) 335 obarray 'boundp t))
342 (list (if (equal val "") 336 (list (if (equal val "")
343 v (intern val))))) 337 v (intern val)))))
344
345 (defun custom-menu-filter (menu widget)
346 "Convert MENU to the form used by `widget-choose'.
347 MENU should be in the same format as `custom-variable-menu'.
348 WIDGET is the widget to apply the filter entries of MENU on."
349 (let ((result nil)
350 current name action filter)
351 (while menu
352 (setq current (car menu)
353 name (nth 0 current)
354 action (nth 1 current)
355 filter (nth 2 current)
356 menu (cdr menu))
357 (if (or (null filter) (funcall filter widget))
358 (push (cons name action) result)
359 (push name result)))
360 (nreverse result)))
361 338
362 ;;; Unlispify. 339 ;;; Unlispify.
363 340
364 (defvar custom-prefix-list nil 341 (defvar custom-prefix-list nil
365 "List of prefixes that should be ignored by `custom-unlispify'") 342 "List of prefixes that should be ignored by `custom-unlispify'")
564 (when (stringp symbol) 541 (when (stringp symbol)
565 (if (string-equal "" symbol) 542 (if (string-equal "" symbol)
566 (setq symbol 'emacs) 543 (setq symbol 'emacs)
567 (setq symbol (intern symbol)))) 544 (setq symbol (intern symbol))))
568 (custom-buffer-create (list (list symbol 'custom-group)))) 545 (custom-buffer-create (list (list symbol 'custom-group))))
569
570 ;;;###autoload
571 (defun customize-other-window (symbol)
572 "Customize SYMBOL, which must be a customization group."
573 (interactive (list (completing-read "Customize group: (default emacs) "
574 obarray
575 (lambda (symbol)
576 (get symbol 'custom-group))
577 t)))
578
579 (when (stringp symbol)
580 (if (string-equal "" symbol)
581 (setq symbol 'emacs)
582 (setq symbol (intern symbol))))
583 (custom-buffer-create-other-window (list (list symbol 'custom-group))))
584 546
585 ;;;###autoload 547 ;;;###autoload
586 (defun customize-variable (symbol) 548 (defun customize-variable (symbol)
587 "Customize SYMBOL, which must be a variable." 549 "Customize SYMBOL, which must be a variable."
588 (interactive (custom-variable-prompt)) 550 (interactive (custom-variable-prompt))
953 915
954 (define-widget 'custom-magic 'default 916 (define-widget 'custom-magic 'default
955 "Show and manipulate state for a customization option." 917 "Show and manipulate state for a customization option."
956 :format "%v" 918 :format "%v"
957 :action 'widget-choice-item-action 919 :action 'widget-choice-item-action
958 :notify 'ignore
959 :value-get 'ignore 920 :value-get 'ignore
960 :value-create 'custom-magic-value-create 921 :value-create 'custom-magic-value-create
961 :value-delete 'widget-children-value-delete) 922 :value-delete 'widget-children-value-delete)
962 923
963 (defun custom-magic-value-create (widget) 924 (defun custom-magic-value-create (widget)
1013 :help-echo "Expand or collapse this item." 974 :help-echo "Expand or collapse this item."
1014 :action 'custom-level-action) 975 :action 'custom-level-action)
1015 976
1016 (defun custom-level-action (widget &optional event) 977 (defun custom-level-action (widget &optional event)
1017 "Toggle visibility for parent to WIDGET." 978 "Toggle visibility for parent to WIDGET."
1018 (custom-toggle-hide (widget-get widget :parent))) 979 (let* ((parent (widget-get widget :parent))
980 (state (widget-get parent :custom-state)))
981 (cond ((memq state '(invalid modified))
982 (error "There are unset changes"))
983 ((eq state 'hidden)
984 (widget-put parent :custom-state 'unknown))
985 (t
986 (widget-put parent :custom-state 'hidden)))
987 (custom-redraw parent)))
1019 988
1020 ;;; The `custom' Widget. 989 ;;; The `custom' Widget.
1021 990
1022 (define-widget 'custom 'default 991 (define-widget 'custom 'default
1023 "Customize a user option." 992 "Customize a user option."
1101 (custom-magic-reset widget)) 1070 (custom-magic-reset widget))
1102 (apply 'widget-default-notify widget args)) 1071 (apply 'widget-default-notify widget args))
1103 1072
1104 (defun custom-redraw (widget) 1073 (defun custom-redraw (widget)
1105 "Redraw WIDGET with current settings." 1074 "Redraw WIDGET with current settings."
1106 (let ((line (count-lines (point-min) (point))) 1075 (let ((pos (point))
1107 (column (current-column))
1108 (pos (point))
1109 (from (marker-position (widget-get widget :from))) 1076 (from (marker-position (widget-get widget :from)))
1110 (to (marker-position (widget-get widget :to)))) 1077 (to (marker-position (widget-get widget :to))))
1111 (save-excursion 1078 (save-excursion
1112 (widget-value-set widget (widget-value widget)) 1079 (widget-value-set widget (widget-value widget))
1113 (custom-redraw-magic widget)) 1080 (custom-redraw-magic widget))
1114 (when (and (>= pos from) (<= pos to)) 1081 (when (and (>= pos from) (<= pos to))
1115 (condition-case nil 1082 (goto-char pos))))
1116 (progn
1117 (goto-line line)
1118 (move-to-column column))
1119 (error nil)))))
1120 1083
1121 (defun custom-redraw-magic (widget) 1084 (defun custom-redraw-magic (widget)
1122 "Redraw WIDGET state with current settings." 1085 "Redraw WIDGET state with current settings."
1123 (while widget 1086 (while widget
1124 (let ((magic (widget-get widget :custom-magic))) 1087 (let ((magic (widget-get widget :custom-magic)))
1163 1126
1164 (defun custom-load-widget (widget) 1127 (defun custom-load-widget (widget)
1165 "Load all dependencies for WIDGET." 1128 "Load all dependencies for WIDGET."
1166 (custom-load-symbol (widget-value widget))) 1129 (custom-load-symbol (widget-value widget)))
1167 1130
1168 (defun custom-toggle-hide (widget)
1169 "Toggle visibility of WIDGET."
1170 (let ((state (widget-get widget :custom-state)))
1171 (cond ((memq state '(invalid modified))
1172 (error "There are unset changes"))
1173 ((eq state 'hidden)
1174 (widget-put widget :custom-state 'unknown))
1175 (t
1176 (widget-put widget :custom-state 'hidden)))
1177 (custom-redraw widget)))
1178
1179 ;;; The `custom-variable' Widget. 1131 ;;; The `custom-variable' Widget.
1180 1132
1181 (defface custom-variable-sample-face '((t (:underline t))) 1133 (defface custom-variable-sample-face '((t (:underline t)))
1182 "Face used for unpushable variable tags." 1134 "Face used for unpushable variable tags."
1183 :group 'custom-faces) 1135 :group 'custom-faces)
1227 (state (widget-get widget :custom-state)) 1179 (state (widget-get widget :custom-state))
1228 (symbol (widget-get widget :value)) 1180 (symbol (widget-get widget :value))
1229 (tag (widget-get widget :tag)) 1181 (tag (widget-get widget :tag))
1230 (type (custom-variable-type symbol)) 1182 (type (custom-variable-type symbol))
1231 (conv (widget-convert type)) 1183 (conv (widget-convert type))
1232 (get (or (get symbol 'custom-get) 'default-value))
1233 (set (or (get symbol 'custom-set) 'set-default))
1234 (value (if (default-boundp symbol) 1184 (value (if (default-boundp symbol)
1235 (funcall get symbol) 1185 (default-value symbol)
1236 (widget-get conv :value)))) 1186 (widget-get conv :value))))
1237 ;; If the widget is new, the child determine whether it is hidden. 1187 ;; If the widget is new, the child determine whether it is hidden.
1238 (cond (state) 1188 (cond (state)
1239 ((custom-show type value) 1189 ((custom-show type value)
1240 (setq state 'unknown)) 1190 (setq state 'unknown))
1260 (let* ((value (cond ((get symbol 'saved-value) 1210 (let* ((value (cond ((get symbol 'saved-value)
1261 (car (get symbol 'saved-value))) 1211 (car (get symbol 'saved-value)))
1262 ((get symbol 'factory-value) 1212 ((get symbol 'factory-value)
1263 (car (get symbol 'factory-value))) 1213 (car (get symbol 'factory-value)))
1264 ((default-boundp symbol) 1214 ((default-boundp symbol)
1265 (custom-quote (funcall get symbol))) 1215 (custom-quote (default-value symbol)))
1266 (t 1216 (t
1267 (custom-quote (widget-get conv :value)))))) 1217 (custom-quote (widget-get conv :value))))))
1268 (push (widget-create-child-and-convert 1218 (push (widget-create-child-and-convert
1269 widget 'sexp 1219 widget 'sexp
1270 :button-face 'custom-variable-button-face 1220 :button-face 'custom-variable-button-face
1292 (widget-put widget :children children))) 1242 (widget-put widget :children children)))
1293 1243
1294 (defun custom-variable-state-set (widget) 1244 (defun custom-variable-state-set (widget)
1295 "Set the state of WIDGET." 1245 "Set the state of WIDGET."
1296 (let* ((symbol (widget-value widget)) 1246 (let* ((symbol (widget-value widget))
1297 (get (or (get symbol 'custom-get) 'default-value))
1298 (value (if (default-boundp symbol) 1247 (value (if (default-boundp symbol)
1299 (funcall get symbol) 1248 (default-value symbol)
1300 (widget-get widget :value))) 1249 (widget-get widget :value)))
1301 tmp 1250 tmp
1302 (state (cond ((setq tmp (get symbol 'customized-value)) 1251 (state (cond ((setq tmp (get symbol 'customized-value))
1303 (if (condition-case nil 1252 (if (condition-case nil
1304 (equal value (eval (car tmp))) 1253 (equal value (eval (car tmp)))
1319 'changed)) 1268 'changed))
1320 (t 'rogue)))) 1269 (t 'rogue))))
1321 (widget-put widget :custom-state state))) 1270 (widget-put widget :custom-state state)))
1322 1271
1323 (defvar custom-variable-menu 1272 (defvar custom-variable-menu
1324 '(("Hide" custom-toggle-hide 1273 '(("Edit" . custom-variable-edit)
1325 (lambda (widget) 1274 ("Edit Lisp" . custom-variable-edit-lisp)
1326 (not (memq (widget-get widget :custom-state) '(modified invalid))))) 1275 ("Set" . custom-variable-set)
1327 ("Edit" custom-variable-edit 1276 ("Save" . custom-variable-save)
1328 (lambda (widget) 1277 ("Reset to Current" . custom-redraw)
1329 (not (eq (widget-get widget :custom-form) 'edit)))) 1278 ("Reset to Saved" . custom-variable-reset-saved)
1330 ("Edit Lisp" custom-variable-edit-lisp 1279 ("Reset to Factory Settings" . custom-variable-reset-factory))
1331 (lambda (widget)
1332 (not (eq (widget-get widget :custom-form) 'lisp))))
1333 ("Set" custom-variable-set
1334 (lambda (widget)
1335 (eq (widget-get widget :custom-state) 'modified)))
1336 ("Save" custom-variable-save
1337 (lambda (widget)
1338 (memq (widget-get widget :custom-state) '(modified set changed rogue))))
1339 ("Reset to Current" custom-redraw
1340 (lambda (widget)
1341 (and (default-boundp (widget-value widget))
1342 (memq (widget-get widget :custom-state) '(modified)))))
1343 ("Reset to Saved" custom-variable-reset-saved
1344 (lambda (widget)
1345 (and (get (widget-value widget) 'saved-value)
1346 (memq (widget-get widget :custom-state)
1347 '(modified set changed rogue)))))
1348 ("Reset to Factory Settings" custom-variable-reset-factory
1349 (lambda (widget)
1350 (and (get (widget-value widget) 'factory-value)
1351 (memq (widget-get widget :custom-state)
1352 '(modified set changed saved rogue))))))
1353 "Alist of actions for the `custom-variable' widget. 1280 "Alist of actions for the `custom-variable' widget.
1354 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 1281 The key is a string containing the name of the action, the value is a
1355 the menu entry, ACTION is the function to call on the widget when the 1282 lisp function taking the widget as an element which will be called
1356 menu is selected, and FILTER is a predicate which takes a `custom-variable' 1283 when the action is chosen.")
1357 widget as an argument, and returns non-nil if ACTION is valid on that
1358 widget. If FILTER is nil, ACTION is always valid.")
1359 1284
1360 (defun custom-variable-action (widget &optional event) 1285 (defun custom-variable-action (widget &optional event)
1361 "Show the menu for `custom-variable' WIDGET. 1286 "Show the menu for `custom-variable' WIDGET.
1362 Optional EVENT is the location for the menu." 1287 Optional EVENT is the location for the menu."
1363 (if (eq (widget-get widget :custom-state) 'hidden) 1288 (if (eq (widget-get widget :custom-state) 'hidden)
1365 (widget-put widget :custom-state 'unknown) 1290 (widget-put widget :custom-state 'unknown)
1366 (custom-redraw widget)) 1291 (custom-redraw widget))
1367 (let* ((completion-ignore-case t) 1292 (let* ((completion-ignore-case t)
1368 (answer (widget-choose (custom-unlispify-tag-name 1293 (answer (widget-choose (custom-unlispify-tag-name
1369 (widget-get widget :value)) 1294 (widget-get widget :value))
1370 (custom-menu-filter custom-variable-menu 1295 custom-variable-menu
1371 widget)
1372 event))) 1296 event)))
1373 (if answer 1297 (if answer
1374 (funcall answer widget))))) 1298 (funcall answer widget)))))
1375 1299
1376 (defun custom-variable-edit (widget) 1300 (defun custom-variable-edit (widget)
1385 (widget-put widget :custom-form 'lisp) 1309 (widget-put widget :custom-form 'lisp)
1386 (custom-redraw widget)) 1310 (custom-redraw widget))
1387 1311
1388 (defun custom-variable-set (widget) 1312 (defun custom-variable-set (widget)
1389 "Set the current value for the variable being edited by WIDGET." 1313 "Set the current value for the variable being edited by WIDGET."
1390 (let* ((form (widget-get widget :custom-form)) 1314 (let ((form (widget-get widget :custom-form))
1391 (state (widget-get widget :custom-state)) 1315 (state (widget-get widget :custom-state))
1392 (child (car (widget-get widget :children))) 1316 (child (car (widget-get widget :children)))
1393 (symbol (widget-value widget)) 1317 (symbol (widget-value widget))
1394 (set (or (get symbol 'custom-set) 'set-default)) 1318 val)
1395 val)
1396 (cond ((eq state 'hidden) 1319 (cond ((eq state 'hidden)
1397 (error "Cannot set hidden variable.")) 1320 (error "Cannot set hidden variable."))
1398 ((setq val (widget-apply child :validate)) 1321 ((setq val (widget-apply child :validate))
1399 (goto-char (widget-get val :from)) 1322 (goto-char (widget-get val :from))
1400 (error "%s" (widget-get val :error))) 1323 (error "%s" (widget-get val :error)))
1401 ((eq form 'lisp) 1324 ((eq form 'lisp)
1402 (funcall set symbol (eval (setq val (widget-value child)))) 1325 (set-default symbol (eval (setq val (widget-value child))))
1403 (put symbol 'customized-value (list val))) 1326 (put symbol 'customized-value (list val)))
1404 (t 1327 (t
1405 (funcall set symbol (setq val (widget-value child))) 1328 (set-default symbol (setq val (widget-value child)))
1406 (put symbol 'customized-value (list (custom-quote val))))) 1329 (put symbol 'customized-value (list (custom-quote val)))))
1407 (custom-variable-state-set widget) 1330 (custom-variable-state-set widget)
1408 (custom-redraw-magic widget))) 1331 (custom-redraw-magic widget)))
1409 1332
1410 (defun custom-variable-save (widget) 1333 (defun custom-variable-save (widget)
1411 "Set the default value for the variable being edited by WIDGET." 1334 "Set the default value for the variable being edited by WIDGET."
1412 (let* ((form (widget-get widget :custom-form)) 1335 (let ((form (widget-get widget :custom-form))
1413 (state (widget-get widget :custom-state)) 1336 (state (widget-get widget :custom-state))
1414 (child (car (widget-get widget :children))) 1337 (child (car (widget-get widget :children)))
1415 (symbol (widget-value widget)) 1338 (symbol (widget-value widget))
1416 (set (or (get symbol 'custom-set) 'set-default)) 1339 val)
1417 val)
1418 (cond ((eq state 'hidden) 1340 (cond ((eq state 'hidden)
1419 (error "Cannot set hidden variable.")) 1341 (error "Cannot set hidden variable."))
1420 ((setq val (widget-apply child :validate)) 1342 ((setq val (widget-apply child :validate))
1421 (goto-char (widget-get val :from)) 1343 (goto-char (widget-get val :from))
1422 (error "%s" (widget-get val :error))) 1344 (error "%s" (widget-get val :error)))
1423 ((eq form 'lisp) 1345 ((eq form 'lisp)
1424 (put symbol 'saved-value (list (widget-value child))) 1346 (put symbol 'saved-value (list (widget-value child)))
1425 (funcall set symbol (eval (widget-value child)))) 1347 (set-default symbol (eval (widget-value child))))
1426 (t 1348 (t
1427 (put symbol 1349 (put symbol
1428 'saved-value (list (custom-quote (widget-value 1350 'saved-value (list (custom-quote (widget-value
1429 child)))) 1351 child))))
1430 (funcall set symbol (widget-value child)))) 1352 (set-default symbol (widget-value child))))
1431 (put symbol 'customized-value nil) 1353 (put symbol 'customized-value nil)
1432 (custom-save-all) 1354 (custom-save-all)
1433 (custom-variable-state-set widget) 1355 (custom-variable-state-set widget)
1434 (custom-redraw-magic widget))) 1356 (custom-redraw-magic widget)))
1435 1357
1436 (defun custom-variable-reset-saved (widget) 1358 (defun custom-variable-reset-saved (widget)
1437 "Restore the saved value for the variable being edited by WIDGET." 1359 "Restore the saved value for the variable being edited by WIDGET."
1438 (let* ((symbol (widget-value widget)) 1360 (let ((symbol (widget-value widget)))
1439 (set (or (get symbol 'custom-set) 'set-default)))
1440 (if (get symbol 'saved-value) 1361 (if (get symbol 'saved-value)
1441 (condition-case nil 1362 (condition-case nil
1442 (funcall set symbol (eval (car (get symbol 'saved-value)))) 1363 (set-default symbol (eval (car (get symbol 'saved-value))))
1443 (error nil)) 1364 (error nil))
1444 (error "No saved value for %s" symbol)) 1365 (error "No saved value for %s" symbol))
1445 (put symbol 'customized-value nil) 1366 (put symbol 'customized-value nil)
1446 (widget-put widget :custom-state 'unknown) 1367 (widget-put widget :custom-state 'unknown)
1447 (custom-redraw widget))) 1368 (custom-redraw widget)))
1448 1369
1449 (defun custom-variable-reset-factory (widget) 1370 (defun custom-variable-reset-factory (widget)
1450 "Restore the factory setting for the variable being edited by WIDGET." 1371 "Restore the factory setting for the variable being edited by WIDGET."
1451 (let* ((symbol (widget-value widget)) 1372 (let ((symbol (widget-value widget)))
1452 (set (or (get symbol 'custom-set) 'set-default)))
1453 (if (get symbol 'factory-value) 1373 (if (get symbol 'factory-value)
1454 (funcall set symbol (eval (car (get symbol 'factory-value)))) 1374 (set-default symbol (eval (car (get symbol 'factory-value))))
1455 (error "No factory default for %S" symbol)) 1375 (error "No factory default for %S" symbol))
1456 (put symbol 'customized-value nil) 1376 (put symbol 'customized-value nil)
1457 (when (get symbol 'saved-value) 1377 (when (get symbol 'saved-value)
1458 (put symbol 'saved-value nil) 1378 (put symbol 'saved-value nil)
1459 (custom-save-all)) 1379 (custom-save-all))
1606 "A display specification that doesn't match the selected display." 1526 "A display specification that doesn't match the selected display."
1607 :match 'custom-display-unselected-match) 1527 :match 'custom-display-unselected-match)
1608 1528
1609 (defun custom-display-unselected-match (widget value) 1529 (defun custom-display-unselected-match (widget value)
1610 "Non-nil if VALUE is an unselected display specification." 1530 "Non-nil if VALUE is an unselected display specification."
1611 (not (custom-display-match-frame value (selected-frame)))) 1531 (and (listp value)
1532 (eq (length value) 2)
1533 (not (custom-display-match-frame value (selected-frame)))))
1612 1534
1613 (define-widget 'custom-face-selected 'group 1535 (define-widget 'custom-face-selected 'group
1614 "Edit the attributes of the selected display in a face specification." 1536 "Edit the attributes of the selected display in a face specification."
1615 :args '((repeat :format "" 1537 :args '((repeat :format ""
1616 :inline t 1538 :inline t
1654 (custom-face-state-set widget) 1576 (custom-face-state-set widget)
1655 (widget-put widget :children (list edit))) 1577 (widget-put widget :children (list edit)))
1656 (message "Creating face editor...done"))) 1578 (message "Creating face editor...done")))
1657 1579
1658 (defvar custom-face-menu 1580 (defvar custom-face-menu
1659 '(("Hide" custom-toggle-hide 1581 '(("Edit Selected" . custom-face-edit-selected)
1660 (lambda (widget) 1582 ("Edit All" . custom-face-edit-all)
1661 (not (memq (widget-get widget :custom-state) '(modified invalid))))) 1583 ("Edit Lisp" . custom-face-edit-lisp)
1662 ("Edit Selected" custom-face-edit-selected 1584 ("Set" . custom-face-set)
1663 (lambda (widget) 1585 ("Save" . custom-face-save)
1664 (not (eq (widget-get widget :custom-form) 'selected)))) 1586 ("Reset to Saved" . custom-face-reset-saved)
1665 ("Edit All" custom-face-edit-all 1587 ("Reset to Factory Setting" . custom-face-reset-factory))
1666 (lambda (widget)
1667 (not (eq (widget-get widget :custom-form) 'all))))
1668 ("Edit Lisp" custom-face-edit-lisp
1669 (lambda (widget)
1670 (not (eq (widget-get widget :custom-form) 'lisp))))
1671 ("Set" custom-face-set)
1672 ("Save" custom-face-save)
1673 ("Reset to Saved" custom-face-reset-saved
1674 (lambda (widget)
1675 (get (widget-value widget) 'saved-face)))
1676 ("Reset to Factory Setting" custom-face-reset-factory
1677 (lambda (widget)
1678 (get (widget-value widget) 'factory-face))))
1679 "Alist of actions for the `custom-face' widget. 1588 "Alist of actions for the `custom-face' widget.
1680 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 1589 The key is a string containing the name of the action, the value is a
1681 the menu entry, ACTION is the function to call on the widget when the 1590 lisp function taking the widget as an element which will be called
1682 menu is selected, and FILTER is a predicate which takes a `custom-face' 1591 when the action is chosen.")
1683 widget as an argument, and returns non-nil if ACTION is valid on that
1684 widget. If FILTER is nil, ACTION is always valid.")
1685 1592
1686 (defun custom-face-edit-selected (widget) 1593 (defun custom-face-edit-selected (widget)
1687 "Edit selected attributes of the value of WIDGET." 1594 "Edit selected attributes of the value of WIDGET."
1688 (widget-put widget :custom-state 'unknown) 1595 (widget-put widget :custom-state 'unknown)
1689 (widget-put widget :custom-form 'selected) 1596 (widget-put widget :custom-form 'selected)
1721 (widget-put widget :custom-state 'unknown) 1628 (widget-put widget :custom-state 'unknown)
1722 (custom-redraw widget)) 1629 (custom-redraw widget))
1723 (let* ((completion-ignore-case t) 1630 (let* ((completion-ignore-case t)
1724 (symbol (widget-get widget :value)) 1631 (symbol (widget-get widget :value))
1725 (answer (widget-choose (custom-unlispify-tag-name symbol) 1632 (answer (widget-choose (custom-unlispify-tag-name symbol)
1726 (custom-menu-filter custom-face-menu 1633 custom-face-menu event)))
1727 widget)
1728 event)))
1729 (if answer 1634 (if answer
1730 (funcall answer widget))))) 1635 (funcall answer widget)))))
1731 1636
1732 (defun custom-face-set (widget) 1637 (defun custom-face-set (widget)
1733 "Make the face attributes in WIDGET take effect." 1638 "Make the face attributes in WIDGET take effect."
1944 (widget-put widget :children children) 1849 (widget-put widget :children children)
1945 (custom-group-state-update widget) 1850 (custom-group-state-update widget)
1946 (message "Creating group... done"))))) 1851 (message "Creating group... done")))))
1947 1852
1948 (defvar custom-group-menu 1853 (defvar custom-group-menu
1949 '(("Hide" custom-toggle-hide 1854 '(("Set" . custom-group-set)
1950 (lambda (widget) 1855 ("Save" . custom-group-save)
1951 (not (memq (widget-get widget :custom-state) '(modified invalid))))) 1856 ("Reset to Current" . custom-group-reset-current)
1952 ("Set" custom-group-set 1857 ("Reset to Saved" . custom-group-reset-saved)
1953 (lambda (widget) 1858 ("Reset to Factory" . custom-group-reset-factory))
1954 (eq (widget-get widget :custom-state) 'modified)))
1955 ("Save" custom-group-save
1956 (lambda (widget)
1957 (memq (widget-get widget :custom-state) '(modified set))))
1958 ("Reset to Current" custom-group-reset-current
1959 (lambda (widget)
1960 (and (default-boundp (widget-value widget))
1961 (memq (widget-get widget :custom-state) '(modified)))))
1962 ("Reset to Saved" custom-group-reset-saved
1963 (lambda (widget)
1964 (and (get (widget-value widget) 'saved-value)
1965 (memq (widget-get widget :custom-state) '(modified set)))))
1966 ("Reset to Factory" custom-group-reset-factory
1967 (lambda (widget)
1968 (and (get (widget-value widget) 'factory-value)
1969 (memq (widget-get widget :custom-state) '(modified set saved))))))
1970 "Alist of actions for the `custom-group' widget. 1859 "Alist of actions for the `custom-group' widget.
1971 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 1860 The key is a string containing the name of the action, the value is a
1972 the menu entry, ACTION is the function to call on the widget when the 1861 lisp function taking the widget as an element which will be called
1973 menu is selected, and FILTER is a predicate which takes a `custom-group' 1862 when the action is chosen.")
1974 widget as an argument, and returns non-nil if ACTION is valid on that
1975 widget. If FILTER is nil, ACTION is always valid.")
1976 1863
1977 (defun custom-group-action (widget &optional event) 1864 (defun custom-group-action (widget &optional event)
1978 "Show the menu for `custom-group' WIDGET. 1865 "Show the menu for `custom-group' WIDGET.
1979 Optional EVENT is the location for the menu." 1866 Optional EVENT is the location for the menu."
1980 (if (eq (widget-get widget :custom-state) 'hidden) 1867 (if (eq (widget-get widget :custom-state) 'hidden)
1982 (widget-put widget :custom-state 'unknown) 1869 (widget-put widget :custom-state 'unknown)
1983 (custom-redraw widget)) 1870 (custom-redraw widget))
1984 (let* ((completion-ignore-case t) 1871 (let* ((completion-ignore-case t)
1985 (answer (widget-choose (custom-unlispify-tag-name 1872 (answer (widget-choose (custom-unlispify-tag-name
1986 (widget-get widget :value)) 1873 (widget-get widget :value))
1987 (custom-menu-filter custom-group-menu 1874 custom-group-menu
1988 widget)
1989 event))) 1875 event)))
1990 (if answer 1876 (if answer
1991 (funcall answer widget))))) 1877 (funcall answer widget)))))
1992 1878
1993 (defun custom-group-set (widget) 1879 (defun custom-group-set (widget)
2084 (let ((standard-output (current-buffer))) 1970 (let ((standard-output (current-buffer)))
2085 (unless (bolp) 1971 (unless (bolp)
2086 (princ "\n")) 1972 (princ "\n"))
2087 (princ "(custom-set-variables") 1973 (princ "(custom-set-variables")
2088 (mapatoms (lambda (symbol) 1974 (mapatoms (lambda (symbol)
2089 (let ((value (get symbol 'saved-value)) 1975 (let ((value (get symbol 'saved-value)))
2090 (requests (get symbol 'custom-requests))
2091 (now (not (or (get symbol 'factory-value)
2092 (and (not (boundp symbol))
2093 (not (get symbol 'force-value)))))))
2094 (when value 1976 (when value
2095 (princ "\n '(") 1977 (princ "\n '(")
2096 (princ symbol) 1978 (princ symbol)
2097 (princ " ") 1979 (princ " ")
2098 (prin1 (car value)) 1980 (prin1 (car value))
2099 (cond (requests 1981 (if (or (get symbol 'factory-value)
2100 (if now 1982 (and (not (boundp symbol))
2101 (princ " t ") 1983 (not (get symbol 'force-value))))
2102 (princ " nil ")) 1984 (princ ")")
2103 (prin1 requests) 1985 (princ " t)"))))))
2104 (princ ")"))
2105 (now
2106 (princ " t)"))
2107 (t
2108 (princ ")")))))))
2109 (princ ")") 1986 (princ ")")
2110 (unless (looking-at "\n") 1987 (unless (looking-at "\n")
2111 (princ "\n"))))) 1988 (princ "\n")))))
2112 1989
2113 (defun custom-save-faces () 1990 (defun custom-save-faces ()
2285 (set-keymap-parent custom-mode-map widget-keymap) 2162 (set-keymap-parent custom-mode-map widget-keymap)
2286 (define-key custom-mode-map "q" 'bury-buffer)) 2163 (define-key custom-mode-map "q" 'bury-buffer))
2287 2164
2288 (easy-menu-define custom-mode-customize-menu 2165 (easy-menu-define custom-mode-customize-menu
2289 custom-mode-map 2166 custom-mode-map
2290 "Menu used to customize customization buffers." 2167 "Menu used in customization buffers."
2291 (customize-menu-create 'customize)) 2168 (customize-menu-create 'customize))
2292 2169
2293 (easy-menu-define custom-mode-menu 2170 (easy-menu-define custom-mode-menu
2294 custom-mode-map 2171 custom-mode-map
2295 "Menu used in customization buffers." 2172 "Menu used in customization buffers."