aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/cus-edit.el
diff options
context:
space:
mode:
authorPer Abrahamsen1997-04-24 16:53:55 +0000
committerPer Abrahamsen1997-04-24 16:53:55 +0000
commit6d528fc505f6be1e67f87834bdde19cf4bbe05ff (patch)
tree10684dfedc376c7ed84936112fd4bb2227c0342c /lisp/cus-edit.el
parentee82af565d241057341ba3c84505149e2213f416 (diff)
downloademacs-6d528fc505f6be1e67f87834bdde19cf4bbe05ff.tar.gz
emacs-6d528fc505f6be1e67f87834bdde19cf4bbe05ff.zip
Synched with custom 1.90.
Diffstat (limited to 'lisp/cus-edit.el')
-rw-r--r--lisp/cus-edit.el398
1 files changed, 312 insertions, 86 deletions
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 43a8ca53ade..eafbcec48c9 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.84 7;; Version: 1.90
8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
@@ -26,6 +26,8 @@
26 26
27;;; Commentary: 27;;; Commentary:
28;; 28;;
29;; This file implements the code to create and edit customize buffers.
30;;
29;; See `custom.el'. 31;; See `custom.el'.
30 32
31;;; Code: 33;;; Code:
@@ -33,6 +35,11 @@
33(require 'cus-face) 35(require 'cus-face)
34(require 'wid-edit) 36(require 'wid-edit)
35(require 'easymenu) 37(require 'easymenu)
38(eval-when-compile (require 'cl))
39
40(condition-case nil
41 (require 'cus-load)
42 (error nil))
36 43
37(defun custom-face-display-set (face spec &optional frame) 44(defun custom-face-display-set (face spec &optional frame)
38 (face-spec-set face spec frame)) 45 (face-spec-set face spec frame))
@@ -355,10 +362,30 @@ Return a list suitable for use in `interactive'."
355 (if v 362 (if v
356 (format "Customize variable (default %s): " v) 363 (format "Customize variable (default %s): " v)
357 "Customize variable: ") 364 "Customize variable: ")
358 obarray 'boundp t)) 365 obarray (lambda (symbol)
366 (and (boundp symbol)
367 (or (get symbol 'custom-type)
368 (user-variable-p symbol))))))
359 (list (if (equal val "") 369 (list (if (equal val "")
360 v (intern val))))) 370 v (intern val)))))
361 371
372(defun custom-menu-filter (menu widget)
373 "Convert MENU to the form used by `widget-choose'.
374MENU should be in the same format as `custom-variable-menu'.
375WIDGET is the widget to apply the filter entries of MENU on."
376 (let ((result nil)
377 current name action filter)
378 (while menu
379 (setq current (car menu)
380 name (nth 0 current)
381 action (nth 1 current)
382 filter (nth 2 current)
383 menu (cdr menu))
384 (if (or (null filter) (funcall filter widget))
385 (push (cons name action) result)
386 (push name result)))
387 (nreverse result)))
388
362;;; Unlispify. 389;;; Unlispify.
363 390
364(defvar custom-prefix-list nil 391(defvar custom-prefix-list nil
@@ -552,6 +579,74 @@ when the action is chosen.")
552 579
553;;; The Customize Commands 580;;; The Customize Commands
554 581
582(defun custom-prompt-variable (prompt-var prompt-val)
583 "Prompt for a variable and a value and return them as a list.
584PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
585prompt for the value. The %s escape in PROMPT-VAL is replaced with
586the name of the variable.
587
588If the variable has a `variable-interactive' property, that is used as if
589it were the arg to `interactive' (which see) to interactively read the value.
590
591If the variable has a `custom-type' property, it must be a widget and the
592`:prompt-value' property of that widget will be used for reading the value."
593 (let* ((var (read-variable prompt-var))
594 (minibuffer-help-form '(describe-variable var)))
595 (list var
596 (let ((prop (get var 'variable-interactive))
597 (type (get var 'custom-type))
598 (prompt (format prompt-val var)))
599 (unless (listp type)
600 (setq type (list type)))
601 (cond (prop
602 ;; Use VAR's `variable-interactive' property
603 ;; as an interactive spec for prompting.
604 (call-interactively (list 'lambda '(arg)
605 (list 'interactive prop)
606 'arg)))
607 (type
608 (widget-prompt-value type
609 prompt
610 (if (boundp var)
611 (symbol-value var))
612 (not (boundp var))))
613 (t
614 (eval-minibuffer prompt)))))))
615
616;;;###autoload
617(defun custom-set-value (var val)
618 "Set VARIABLE to VALUE. VALUE is a Lisp object.
619
620If VARIABLE has a `variable-interactive' property, that is used as if
621it were the arg to `interactive' (which see) to interactively read the value.
622
623If VARIABLE has a `custom-type' property, it must be a widget and the
624`:prompt-value' property of that widget will be used for reading the value."
625 (interactive (custom-prompt-variable "Set variable: "
626 "Set %s to value: "))
627
628 (set var val))
629
630;;;###autoload
631(defun custom-set-variable (var val)
632 "Set the default for VARIABLE to VALUE. VALUE is a Lisp object.
633
634If VARIABLE has a `custom-set' property, that is used for setting
635VARIABLE, otherwise `set-default' is used.
636
637The `customized-value' property of the VARIABLE will be set to a list
638with a quoted VALUE as its sole list member.
639
640If VARIABLE has a `variable-interactive' property, that is used as if
641it were the arg to `interactive' (which see) to interactively read the value.
642
643If VARIABLE has a `custom-type' property, it must be a widget and the
644`:prompt-value' property of that widget will be used for reading the value. "
645 (interactive (custom-prompt-variable "Set variable: "
646 "Set customized value for %s to: "))
647 (funcall (or (get var 'custom-set) 'set-default) var val)
648 (put var 'customized-value (list (custom-quote val))))
649
555;;;###autoload 650;;;###autoload
556(defun customize (symbol) 651(defun customize (symbol)
557 "Customize SYMBOL, which must be a customization group." 652 "Customize SYMBOL, which must be a customization group."
@@ -568,6 +663,21 @@ when the action is chosen.")
568 (custom-buffer-create (list (list symbol 'custom-group)))) 663 (custom-buffer-create (list (list symbol 'custom-group))))
569 664
570;;;###autoload 665;;;###autoload
666(defun customize-other-window (symbol)
667 "Customize SYMBOL, which must be a customization group."
668 (interactive (list (completing-read "Customize group: (default emacs) "
669 obarray
670 (lambda (symbol)
671 (get symbol 'custom-group))
672 t)))
673
674 (when (stringp symbol)
675 (if (string-equal "" symbol)
676 (setq symbol 'emacs)
677 (setq symbol (intern symbol))))
678 (custom-buffer-create-other-window (list (list symbol 'custom-group))))
679
680;;;###autoload
571(defun customize-variable (symbol) 681(defun customize-variable (symbol)
572 "Customize SYMBOL, which must be a variable." 682 "Customize SYMBOL, which must be a variable."
573 (interactive (custom-variable-prompt)) 683 (interactive (custom-variable-prompt))
@@ -617,7 +727,24 @@ If SYMBOL is nil, customize all faces."
617 727
618;;;###autoload 728;;;###autoload
619(defun customize-customized () 729(defun customize-customized ()
620 "Customize all already customized user options." 730 "Customize all user options set since the last save in this session."
731 (interactive)
732 (let ((found nil))
733 (mapatoms (lambda (symbol)
734 (and (get symbol 'customized-face)
735 (custom-facep symbol)
736 (setq found (cons (list symbol 'custom-face) found)))
737 (and (get symbol 'customized-value)
738 (boundp symbol)
739 (setq found
740 (cons (list symbol 'custom-variable) found)))))
741 (if found
742 (custom-buffer-create found)
743 (error "No customized user options"))))
744
745;;;###autoload
746(defun customize-saved ()
747 "Customize all already saved user options."
621 (interactive) 748 (interactive)
622 (let ((found nil)) 749 (let ((found nil))
623 (mapatoms (lambda (symbol) 750 (mapatoms (lambda (symbol)
@@ -630,7 +757,7 @@ If SYMBOL is nil, customize all faces."
630 (cons (list symbol 'custom-variable) found))))) 757 (cons (list symbol 'custom-variable) found)))))
631 (if found 758 (if found
632 (custom-buffer-create found) 759 (custom-buffer-create found)
633 (error "No customized user options")))) 760 (error "No saved user options"))))
634 761
635;;;###autoload 762;;;###autoload
636(defun customize-apropos (regexp &optional all) 763(defun customize-apropos (regexp &optional all)
@@ -657,6 +784,8 @@ user-settable."
657 (custom-buffer-create found) 784 (custom-buffer-create found)
658 (error "No matches")))) 785 (error "No matches"))))
659 786
787;;; Buffer.
788
660;;;###autoload 789;;;###autoload
661(defun custom-buffer-create (options) 790(defun custom-buffer-create (options)
662 "Create a buffer containing OPTIONS. 791 "Create a buffer containing OPTIONS.
@@ -667,6 +796,7 @@ that option."
667 (switch-to-buffer (get-buffer-create "*Customization*")) 796 (switch-to-buffer (get-buffer-create "*Customization*"))
668 (custom-buffer-create-internal options)) 797 (custom-buffer-create-internal options))
669 798
799;;;###autoload
670(defun custom-buffer-create-other-window (options) 800(defun custom-buffer-create-other-window (options)
671 "Create a buffer containing OPTIONS. 801 "Create a buffer containing OPTIONS.
672OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where 802OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
@@ -758,6 +888,7 @@ Make the modifications default for future sessions."
758 (message "Creating customization setup...") 888 (message "Creating customization setup...")
759 (widget-setup) 889 (widget-setup)
760 (goto-char (point-min)) 890 (goto-char (point-min))
891 (forward-line 3) ;Kludge: bob is writable in XEmacs.
761 (message "Creating customization buffer...done")) 892 (message "Creating customization buffer...done"))
762 893
763;;; Modification of Basic Widgets. 894;;; Modification of Basic Widgets.
@@ -939,6 +1070,7 @@ The list should be sorted most significant first."
939 "Show and manipulate state for a customization option." 1070 "Show and manipulate state for a customization option."
940 :format "%v" 1071 :format "%v"
941 :action 'widget-choice-item-action 1072 :action 'widget-choice-item-action
1073 :notify 'ignore
942 :value-get 'ignore 1074 :value-get 'ignore
943 :value-create 'custom-magic-value-create 1075 :value-create 'custom-magic-value-create
944 :value-delete 'widget-children-value-delete) 1076 :value-delete 'widget-children-value-delete)
@@ -998,15 +1130,7 @@ Change the state of this item."
998 1130
999(defun custom-level-action (widget &optional event) 1131(defun custom-level-action (widget &optional event)
1000 "Toggle visibility for parent to WIDGET." 1132 "Toggle visibility for parent to WIDGET."
1001 (let* ((parent (widget-get widget :parent)) 1133 (custom-toggle-hide (widget-get widget :parent)))
1002 (state (widget-get parent :custom-state)))
1003 (cond ((memq state '(invalid modified))
1004 (error "There are unset changes"))
1005 ((eq state 'hidden)
1006 (widget-put parent :custom-state 'unknown))
1007 (t
1008 (widget-put parent :custom-state 'hidden)))
1009 (custom-redraw parent)))
1010 1134
1011;;; The `custom' Widget. 1135;;; The `custom' Widget.
1012 1136
@@ -1094,14 +1218,20 @@ Change the state of this item."
1094 1218
1095(defun custom-redraw (widget) 1219(defun custom-redraw (widget)
1096 "Redraw WIDGET with current settings." 1220 "Redraw WIDGET with current settings."
1097 (let ((pos (point)) 1221 (let ((line (count-lines (point-min) (point)))
1222 (column (current-column))
1223 (pos (point))
1098 (from (marker-position (widget-get widget :from))) 1224 (from (marker-position (widget-get widget :from)))
1099 (to (marker-position (widget-get widget :to)))) 1225 (to (marker-position (widget-get widget :to))))
1100 (save-excursion 1226 (save-excursion
1101 (widget-value-set widget (widget-value widget)) 1227 (widget-value-set widget (widget-value widget))
1102 (custom-redraw-magic widget)) 1228 (custom-redraw-magic widget))
1103 (when (and (>= pos from) (<= pos to)) 1229 (when (and (>= pos from) (<= pos to))
1104 (goto-char pos)))) 1230 (condition-case nil
1231 (progn
1232 (goto-line line)
1233 (move-to-column column))
1234 (error nil)))))
1105 1235
1106(defun custom-redraw-magic (widget) 1236(defun custom-redraw-magic (widget)
1107 "Redraw WIDGET state with current settings." 1237 "Redraw WIDGET state with current settings."
@@ -1150,6 +1280,17 @@ Change the state of this item."
1150 "Load all dependencies for WIDGET." 1280 "Load all dependencies for WIDGET."
1151 (custom-load-symbol (widget-value widget))) 1281 (custom-load-symbol (widget-value widget)))
1152 1282
1283(defun custom-toggle-hide (widget)
1284 "Toggle visibility of WIDGET."
1285 (let ((state (widget-get widget :custom-state)))
1286 (cond ((memq state '(invalid modified))
1287 (error "There are unset changes"))
1288 ((eq state 'hidden)
1289 (widget-put widget :custom-state 'unknown))
1290 (t
1291 (widget-put widget :custom-state 'hidden)))
1292 (custom-redraw widget)))
1293
1153;;; The `custom-variable' Widget. 1294;;; The `custom-variable' Widget.
1154 1295
1155(defface custom-variable-sample-face '((t (:underline t))) 1296(defface custom-variable-sample-face '((t (:underline t)))
@@ -1203,8 +1344,10 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
1203 (tag (widget-get widget :tag)) 1344 (tag (widget-get widget :tag))
1204 (type (custom-variable-type symbol)) 1345 (type (custom-variable-type symbol))
1205 (conv (widget-convert type)) 1346 (conv (widget-convert type))
1347 (get (or (get symbol 'custom-get) 'default-value))
1348 (set (or (get symbol 'custom-set) 'set-default))
1206 (value (if (default-boundp symbol) 1349 (value (if (default-boundp symbol)
1207 (default-value symbol) 1350 (funcall get symbol)
1208 (widget-get conv :value)))) 1351 (widget-get conv :value))))
1209 ;; If the widget is new, the child determine whether it is hidden. 1352 ;; If the widget is new, the child determine whether it is hidden.
1210 (cond (state) 1353 (cond (state)
@@ -1234,7 +1377,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
1234 ((get symbol 'factory-value) 1377 ((get symbol 'factory-value)
1235 (car (get symbol 'factory-value))) 1378 (car (get symbol 'factory-value)))
1236 ((default-boundp symbol) 1379 ((default-boundp symbol)
1237 (custom-quote (default-value symbol))) 1380 (custom-quote (funcall get symbol)))
1238 (t 1381 (t
1239 (custom-quote (widget-get conv :value)))))) 1382 (custom-quote (widget-get conv :value))))))
1240 (push (widget-create-child-and-convert 1383 (push (widget-create-child-and-convert
@@ -1266,8 +1409,9 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
1266(defun custom-variable-state-set (widget) 1409(defun custom-variable-state-set (widget)
1267 "Set the state of WIDGET." 1410 "Set the state of WIDGET."
1268 (let* ((symbol (widget-value widget)) 1411 (let* ((symbol (widget-value widget))
1412 (get (or (get symbol 'custom-get) 'default-value))
1269 (value (if (default-boundp symbol) 1413 (value (if (default-boundp symbol)
1270 (default-value symbol) 1414 (funcall get symbol)
1271 (widget-get widget :value))) 1415 (widget-get widget :value)))
1272 tmp 1416 tmp
1273 (state (cond ((setq tmp (get symbol 'customized-value)) 1417 (state (cond ((setq tmp (get symbol 'customized-value))
@@ -1292,29 +1436,52 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
1292 (widget-put widget :custom-state state))) 1436 (widget-put widget :custom-state state)))
1293 1437
1294(defvar custom-variable-menu 1438(defvar custom-variable-menu
1295 '(("Edit" . custom-variable-edit) 1439 '(("Hide" custom-toggle-hide
1296 ("Edit Lisp" . custom-variable-edit-lisp) 1440 (lambda (widget)
1297 ("Set" . custom-variable-set) 1441 (not (memq (widget-get widget :custom-state) '(modified invalid)))))
1298 ("Save" . custom-variable-save) 1442 ("Edit" custom-variable-edit
1299 ("Reset to Current" . custom-redraw) 1443 (lambda (widget)
1300 ("Reset to Saved" . custom-variable-reset-saved) 1444 (not (eq (widget-get widget :custom-form) 'edit))))
1301 ("Reset to Factory Settings" . custom-variable-reset-factory)) 1445 ("Edit Lisp" custom-variable-edit-lisp
1446 (lambda (widget)
1447 (not (eq (widget-get widget :custom-form) 'lisp))))
1448 ("Set" custom-variable-set
1449 (lambda (widget)
1450 (eq (widget-get widget :custom-state) 'modified)))
1451 ("Save" custom-variable-save
1452 (lambda (widget)
1453 (memq (widget-get widget :custom-state) '(modified set changed rogue))))
1454 ("Reset to Current" custom-redraw
1455 (lambda (widget)
1456 (and (default-boundp (widget-value widget))
1457 (memq (widget-get widget :custom-state) '(modified)))))
1458 ("Reset to Saved" custom-variable-reset-saved
1459 (lambda (widget)
1460 (and (get (widget-value widget) 'saved-value)
1461 (memq (widget-get widget :custom-state)
1462 '(modified set changed rogue)))))
1463 ("Reset to Factory Settings" custom-variable-reset-factory
1464 (lambda (widget)
1465 (and (get (widget-value widget) 'factory-value)
1466 (memq (widget-get widget :custom-state)
1467 '(modified set changed saved rogue))))))
1302 "Alist of actions for the `custom-variable' widget. 1468 "Alist of actions for the `custom-variable' widget.
1303The key is a string containing the name of the action, the value is a 1469Each entry has the form (NAME ACTION FILTER) where NAME is the name of
1304lisp function taking the widget as an element which will be called 1470the menu entry, ACTION is the function to call on the widget when the
1305when the action is chosen.") 1471menu is selected, and FILTER is a predicate which takes a `custom-variable'
1472widget as an argument, and returns non-nil if ACTION is valid on that
1473widget. If FILTER is nil, ACTION is always valid.")
1306 1474
1307(defun custom-variable-action (widget &optional event) 1475(defun custom-variable-action (widget &optional event)
1308 "Show the menu for `custom-variable' WIDGET. 1476 "Show the menu for `custom-variable' WIDGET.
1309Optional EVENT is the location for the menu." 1477Optional EVENT is the location for the menu."
1310 (if (eq (widget-get widget :custom-state) 'hidden) 1478 (if (eq (widget-get widget :custom-state) 'hidden)
1311 (progn 1479 (custom-toggle-hide widget)
1312 (widget-put widget :custom-state 'unknown)
1313 (custom-redraw widget))
1314 (let* ((completion-ignore-case t) 1480 (let* ((completion-ignore-case t)
1315 (answer (widget-choose (custom-unlispify-tag-name 1481 (answer (widget-choose (custom-unlispify-tag-name
1316 (widget-get widget :value)) 1482 (widget-get widget :value))
1317 custom-variable-menu 1483 (custom-menu-filter custom-variable-menu
1484 widget)
1318 event))) 1485 event)))
1319 (if answer 1486 (if answer
1320 (funcall answer widget))))) 1487 (funcall answer widget)))))
@@ -1333,32 +1500,34 @@ Optional EVENT is the location for the menu."
1333 1500
1334(defun custom-variable-set (widget) 1501(defun custom-variable-set (widget)
1335 "Set the current value for the variable being edited by WIDGET." 1502 "Set the current value for the variable being edited by WIDGET."
1336 (let ((form (widget-get widget :custom-form)) 1503 (let* ((form (widget-get widget :custom-form))
1337 (state (widget-get widget :custom-state)) 1504 (state (widget-get widget :custom-state))
1338 (child (car (widget-get widget :children))) 1505 (child (car (widget-get widget :children)))
1339 (symbol (widget-value widget)) 1506 (symbol (widget-value widget))
1340 val) 1507 (set (or (get symbol 'custom-set) 'set-default))
1508 val)
1341 (cond ((eq state 'hidden) 1509 (cond ((eq state 'hidden)
1342 (error "Cannot set hidden variable.")) 1510 (error "Cannot set hidden variable."))
1343 ((setq val (widget-apply child :validate)) 1511 ((setq val (widget-apply child :validate))
1344 (goto-char (widget-get val :from)) 1512 (goto-char (widget-get val :from))
1345 (error "%s" (widget-get val :error))) 1513 (error "%s" (widget-get val :error)))
1346 ((eq form 'lisp) 1514 ((eq form 'lisp)
1347 (set-default symbol (eval (setq val (widget-value child)))) 1515 (funcall set symbol (eval (setq val (widget-value child))))
1348 (put symbol 'customized-value (list val))) 1516 (put symbol 'customized-value (list val)))
1349 (t 1517 (t
1350 (set-default symbol (setq val (widget-value child))) 1518 (funcall set symbol (setq val (widget-value child)))
1351 (put symbol 'customized-value (list (custom-quote val))))) 1519 (put symbol 'customized-value (list (custom-quote val)))))
1352 (custom-variable-state-set widget) 1520 (custom-variable-state-set widget)
1353 (custom-redraw-magic widget))) 1521 (custom-redraw-magic widget)))
1354 1522
1355(defun custom-variable-save (widget) 1523(defun custom-variable-save (widget)
1356 "Set the default value for the variable being edited by WIDGET." 1524 "Set the default value for the variable being edited by WIDGET."
1357 (let ((form (widget-get widget :custom-form)) 1525 (let* ((form (widget-get widget :custom-form))
1358 (state (widget-get widget :custom-state)) 1526 (state (widget-get widget :custom-state))
1359 (child (car (widget-get widget :children))) 1527 (child (car (widget-get widget :children)))
1360 (symbol (widget-value widget)) 1528 (symbol (widget-value widget))
1361 val) 1529 (set (or (get symbol 'custom-set) 'set-default))
1530 val)
1362 (cond ((eq state 'hidden) 1531 (cond ((eq state 'hidden)
1363 (error "Cannot set hidden variable.")) 1532 (error "Cannot set hidden variable."))
1364 ((setq val (widget-apply child :validate)) 1533 ((setq val (widget-apply child :validate))
@@ -1366,12 +1535,12 @@ Optional EVENT is the location for the menu."
1366 (error "%s" (widget-get val :error))) 1535 (error "%s" (widget-get val :error)))
1367 ((eq form 'lisp) 1536 ((eq form 'lisp)
1368 (put symbol 'saved-value (list (widget-value child))) 1537 (put symbol 'saved-value (list (widget-value child)))
1369 (set-default symbol (eval (widget-value child)))) 1538 (funcall set symbol (eval (widget-value child))))
1370 (t 1539 (t
1371 (put symbol 1540 (put symbol
1372 'saved-value (list (custom-quote (widget-value 1541 'saved-value (list (custom-quote (widget-value
1373 child)))) 1542 child))))
1374 (set-default symbol (widget-value child)))) 1543 (funcall set symbol (widget-value child))))
1375 (put symbol 'customized-value nil) 1544 (put symbol 'customized-value nil)
1376 (custom-save-all) 1545 (custom-save-all)
1377 (custom-variable-state-set widget) 1546 (custom-variable-state-set widget)
@@ -1379,10 +1548,11 @@ Optional EVENT is the location for the menu."
1379 1548
1380(defun custom-variable-reset-saved (widget) 1549(defun custom-variable-reset-saved (widget)
1381 "Restore the saved value for the variable being edited by WIDGET." 1550 "Restore the saved value for the variable being edited by WIDGET."
1382 (let ((symbol (widget-value widget))) 1551 (let* ((symbol (widget-value widget))
1552 (set (or (get symbol 'custom-set) 'set-default)))
1383 (if (get symbol 'saved-value) 1553 (if (get symbol 'saved-value)
1384 (condition-case nil 1554 (condition-case nil
1385 (set-default symbol (eval (car (get symbol 'saved-value)))) 1555 (funcall set symbol (eval (car (get symbol 'saved-value))))
1386 (error nil)) 1556 (error nil))
1387 (error "No saved value for %s" symbol)) 1557 (error "No saved value for %s" symbol))
1388 (put symbol 'customized-value nil) 1558 (put symbol 'customized-value nil)
@@ -1391,9 +1561,10 @@ Optional EVENT is the location for the menu."
1391 1561
1392(defun custom-variable-reset-factory (widget) 1562(defun custom-variable-reset-factory (widget)
1393 "Restore the factory setting for the variable being edited by WIDGET." 1563 "Restore the factory setting for the variable being edited by WIDGET."
1394 (let ((symbol (widget-value widget))) 1564 (let* ((symbol (widget-value widget))
1565 (set (or (get symbol 'custom-set) 'set-default)))
1395 (if (get symbol 'factory-value) 1566 (if (get symbol 'factory-value)
1396 (set-default symbol (eval (car (get symbol 'factory-value)))) 1567 (funcall set symbol (eval (car (get symbol 'factory-value))))
1397 (error "No factory default for %S" symbol)) 1568 (error "No factory default for %S" symbol))
1398 (put symbol 'customized-value nil) 1569 (put symbol 'customized-value nil)
1399 (when (get symbol 'saved-value) 1570 (when (get symbol 'saved-value)
@@ -1550,9 +1721,7 @@ Match frames with dark backgrounds.")
1550 1721
1551(defun custom-display-unselected-match (widget value) 1722(defun custom-display-unselected-match (widget value)
1552 "Non-nil if VALUE is an unselected display specification." 1723 "Non-nil if VALUE is an unselected display specification."
1553 (and (listp value) 1724 (not (custom-display-match-frame value (selected-frame))))
1554 (eq (length value) 2)
1555 (not (custom-display-match-frame value (selected-frame)))))
1556 1725
1557(define-widget 'custom-face-selected 'group 1726(define-widget 'custom-face-selected 'group
1558 "Edit the attributes of the selected display in a face specification." 1727 "Edit the attributes of the selected display in a face specification."
@@ -1600,17 +1769,32 @@ Match frames with dark backgrounds.")
1600 (message "Creating face editor...done"))) 1769 (message "Creating face editor...done")))
1601 1770
1602(defvar custom-face-menu 1771(defvar custom-face-menu
1603 '(("Edit Selected" . custom-face-edit-selected) 1772 '(("Hide" custom-toggle-hide
1604 ("Edit All" . custom-face-edit-all) 1773 (lambda (widget)
1605 ("Edit Lisp" . custom-face-edit-lisp) 1774 (not (memq (widget-get widget :custom-state) '(modified invalid)))))
1606 ("Set" . custom-face-set) 1775 ("Edit Selected" custom-face-edit-selected
1607 ("Save" . custom-face-save) 1776 (lambda (widget)
1608 ("Reset to Saved" . custom-face-reset-saved) 1777 (not (eq (widget-get widget :custom-form) 'selected))))
1609 ("Reset to Factory Setting" . custom-face-reset-factory)) 1778 ("Edit All" custom-face-edit-all
1779 (lambda (widget)
1780 (not (eq (widget-get widget :custom-form) 'all))))
1781 ("Edit Lisp" custom-face-edit-lisp
1782 (lambda (widget)
1783 (not (eq (widget-get widget :custom-form) 'lisp))))
1784 ("Set" custom-face-set)
1785 ("Save" custom-face-save)
1786 ("Reset to Saved" custom-face-reset-saved
1787 (lambda (widget)
1788 (get (widget-value widget) 'saved-face)))
1789 ("Reset to Factory Setting" custom-face-reset-factory
1790 (lambda (widget)
1791 (get (widget-value widget) 'factory-face))))
1610 "Alist of actions for the `custom-face' widget. 1792 "Alist of actions for the `custom-face' widget.
1611The key is a string containing the name of the action, the value is a 1793Each entry has the form (NAME ACTION FILTER) where NAME is the name of
1612lisp function taking the widget as an element which will be called 1794the menu entry, ACTION is the function to call on the widget when the
1613when the action is chosen.") 1795menu is selected, and FILTER is a predicate which takes a `custom-face'
1796widget as an argument, and returns non-nil if ACTION is valid on that
1797widget. If FILTER is nil, ACTION is always valid.")
1614 1798
1615(defun custom-face-edit-selected (widget) 1799(defun custom-face-edit-selected (widget)
1616 "Edit selected attributes of the value of WIDGET." 1800 "Edit selected attributes of the value of WIDGET."
@@ -1646,13 +1830,13 @@ when the action is chosen.")
1646 "Show the menu for `custom-face' WIDGET. 1830 "Show the menu for `custom-face' WIDGET.
1647Optional EVENT is the location for the menu." 1831Optional EVENT is the location for the menu."
1648 (if (eq (widget-get widget :custom-state) 'hidden) 1832 (if (eq (widget-get widget :custom-state) 'hidden)
1649 (progn 1833 (custom-toggle-hide widget)
1650 (widget-put widget :custom-state 'unknown)
1651 (custom-redraw widget))
1652 (let* ((completion-ignore-case t) 1834 (let* ((completion-ignore-case t)
1653 (symbol (widget-get widget :value)) 1835 (symbol (widget-get widget :value))
1654 (answer (widget-choose (custom-unlispify-tag-name symbol) 1836 (answer (widget-choose (custom-unlispify-tag-name symbol)
1655 custom-face-menu event))) 1837 (custom-menu-filter custom-face-menu
1838 widget)
1839 event)))
1656 (if answer 1840 (if answer
1657 (funcall answer widget))))) 1841 (funcall answer widget)))))
1658 1842
@@ -1865,27 +2049,44 @@ and so forth. The remaining group tags are shown with
1865 (message "Creating group... done"))))) 2049 (message "Creating group... done")))))
1866 2050
1867(defvar custom-group-menu 2051(defvar custom-group-menu
1868 '(("Set" . custom-group-set) 2052 '(("Hide" custom-toggle-hide
1869 ("Save" . custom-group-save) 2053 (lambda (widget)
1870 ("Reset to Current" . custom-group-reset-current) 2054 (not (memq (widget-get widget :custom-state) '(modified invalid)))))
1871 ("Reset to Saved" . custom-group-reset-saved) 2055 ("Set" custom-group-set
1872 ("Reset to Factory" . custom-group-reset-factory)) 2056 (lambda (widget)
2057 (eq (widget-get widget :custom-state) 'modified)))
2058 ("Save" custom-group-save
2059 (lambda (widget)
2060 (memq (widget-get widget :custom-state) '(modified set))))
2061 ("Reset to Current" custom-group-reset-current
2062 (lambda (widget)
2063 (and (default-boundp (widget-value widget))
2064 (memq (widget-get widget :custom-state) '(modified)))))
2065 ("Reset to Saved" custom-group-reset-saved
2066 (lambda (widget)
2067 (and (get (widget-value widget) 'saved-value)
2068 (memq (widget-get widget :custom-state) '(modified set)))))
2069 ("Reset to Factory" custom-group-reset-factory
2070 (lambda (widget)
2071 (and (get (widget-value widget) 'factory-value)
2072 (memq (widget-get widget :custom-state) '(modified set saved))))))
1873 "Alist of actions for the `custom-group' widget. 2073 "Alist of actions for the `custom-group' widget.
1874The key is a string containing the name of the action, the value is a 2074Each entry has the form (NAME ACTION FILTER) where NAME is the name of
1875lisp function taking the widget as an element which will be called 2075the menu entry, ACTION is the function to call on the widget when the
1876when the action is chosen.") 2076menu is selected, and FILTER is a predicate which takes a `custom-group'
2077widget as an argument, and returns non-nil if ACTION is valid on that
2078widget. If FILTER is nil, ACTION is always valid.")
1877 2079
1878(defun custom-group-action (widget &optional event) 2080(defun custom-group-action (widget &optional event)
1879 "Show the menu for `custom-group' WIDGET. 2081 "Show the menu for `custom-group' WIDGET.
1880Optional EVENT is the location for the menu." 2082Optional EVENT is the location for the menu."
1881 (if (eq (widget-get widget :custom-state) 'hidden) 2083 (if (eq (widget-get widget :custom-state) 'hidden)
1882 (progn 2084 (custom-toggle-hide widget)
1883 (widget-put widget :custom-state 'unknown)
1884 (custom-redraw widget))
1885 (let* ((completion-ignore-case t) 2085 (let* ((completion-ignore-case t)
1886 (answer (widget-choose (custom-unlispify-tag-name 2086 (answer (widget-choose (custom-unlispify-tag-name
1887 (widget-get widget :value)) 2087 (widget-get widget :value))
1888 custom-group-menu 2088 (custom-menu-filter custom-group-menu
2089 widget)
1889 event))) 2090 event)))
1890 (if answer 2091 (if answer
1891 (funcall answer widget))))) 2092 (funcall answer widget)))))
@@ -1986,17 +2187,26 @@ Leave point at the location of the call, or after the last expression."
1986 (princ "\n")) 2187 (princ "\n"))
1987 (princ "(custom-set-variables") 2188 (princ "(custom-set-variables")
1988 (mapatoms (lambda (symbol) 2189 (mapatoms (lambda (symbol)
1989 (let ((value (get symbol 'saved-value))) 2190 (let ((value (get symbol 'saved-value))
2191 (requests (get symbol 'custom-requests))
2192 (now (not (or (get symbol 'factory-value)
2193 (and (not (boundp symbol))
2194 (not (get symbol 'force-value)))))))
1990 (when value 2195 (when value
1991 (princ "\n '(") 2196 (princ "\n '(")
1992 (princ symbol) 2197 (princ symbol)
1993 (princ " ") 2198 (princ " ")
1994 (prin1 (car value)) 2199 (prin1 (car value))
1995 (if (or (get symbol 'factory-value) 2200 (cond (requests
1996 (and (not (boundp symbol)) 2201 (if now
1997 (not (get symbol 'force-value)))) 2202 (princ " t ")
1998 (princ ")") 2203 (princ " nil "))
1999 (princ " t)")))))) 2204 (prin1 requests)
2205 (princ ")"))
2206 (now
2207 (princ " t)"))
2208 (t
2209 (princ ")")))))))
2000 (princ ")") 2210 (princ ")")
2001 (unless (looking-at "\n") 2211 (unless (looking-at "\n")
2002 (princ "\n"))))) 2212 (princ "\n")))))
@@ -2038,6 +2248,22 @@ Leave point at the location of the call, or after the last expression."
2038 (princ "\n"))))) 2248 (princ "\n")))))
2039 2249
2040;;;###autoload 2250;;;###autoload
2251(defun custom-save-customized ()
2252 "Save all user options which have been set in this session."
2253 (interactive)
2254 (mapatoms (lambda (symbol)
2255 (let ((face (get symbol 'customized-face))
2256 (value (get symbol 'customized-value)))
2257 (when face
2258 (put symbol 'saved-face face)
2259 (put symbol 'customized-face nil))
2260 (when value
2261 (put symbol 'saved-value value)
2262 (put symbol 'customized-value nil)))))
2263 ;; We really should update all custom buffers here.
2264 (custom-save-all))
2265
2266;;;###autoload
2041(defun custom-save-all () 2267(defun custom-save-all ()
2042 "Save all customizations in `custom-file'." 2268 "Save all customizations in `custom-file'."
2043 (custom-save-variables) 2269 (custom-save-variables)
@@ -2178,7 +2404,7 @@ The format is suitable for use with `easy-menu-define'."
2178 2404
2179(easy-menu-define custom-mode-customize-menu 2405(easy-menu-define custom-mode-customize-menu
2180 custom-mode-map 2406 custom-mode-map
2181 "Menu used in customization buffers." 2407 "Menu used to customize customization buffers."
2182 (customize-menu-create 'customize)) 2408 (customize-menu-create 'customize))
2183 2409
2184(easy-menu-define custom-mode-menu 2410(easy-menu-define custom-mode-menu