diff options
| author | Per Abrahamsen | 1997-04-24 16:53:55 +0000 |
|---|---|---|
| committer | Per Abrahamsen | 1997-04-24 16:53:55 +0000 |
| commit | 6d528fc505f6be1e67f87834bdde19cf4bbe05ff (patch) | |
| tree | 10684dfedc376c7ed84936112fd4bb2227c0342c /lisp/cus-edit.el | |
| parent | ee82af565d241057341ba3c84505149e2213f416 (diff) | |
| download | emacs-6d528fc505f6be1e67f87834bdde19cf4bbe05ff.tar.gz emacs-6d528fc505f6be1e67f87834bdde19cf4bbe05ff.zip | |
Synched with custom 1.90.
Diffstat (limited to 'lisp/cus-edit.el')
| -rw-r--r-- | lisp/cus-edit.el | 398 |
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'. | ||
| 374 | MENU should be in the same format as `custom-variable-menu'. | ||
| 375 | WIDGET 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. | ||
| 584 | PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the | ||
| 585 | prompt for the value. The %s escape in PROMPT-VAL is replaced with | ||
| 586 | the name of the variable. | ||
| 587 | |||
| 588 | If the variable has a `variable-interactive' property, that is used as if | ||
| 589 | it were the arg to `interactive' (which see) to interactively read the value. | ||
| 590 | |||
| 591 | If 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 | |||
| 620 | If VARIABLE has a `variable-interactive' property, that is used as if | ||
| 621 | it were the arg to `interactive' (which see) to interactively read the value. | ||
| 622 | |||
| 623 | If 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 | |||
| 634 | If VARIABLE has a `custom-set' property, that is used for setting | ||
| 635 | VARIABLE, otherwise `set-default' is used. | ||
| 636 | |||
| 637 | The `customized-value' property of the VARIABLE will be set to a list | ||
| 638 | with a quoted VALUE as its sole list member. | ||
| 639 | |||
| 640 | If VARIABLE has a `variable-interactive' property, that is used as if | ||
| 641 | it were the arg to `interactive' (which see) to interactively read the value. | ||
| 642 | |||
| 643 | If 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. |
| 672 | OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where | 802 | OPTIONS 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. |
| 1303 | The key is a string containing the name of the action, the value is a | 1469 | Each entry has the form (NAME ACTION FILTER) where NAME is the name of |
| 1304 | lisp function taking the widget as an element which will be called | 1470 | the menu entry, ACTION is the function to call on the widget when the |
| 1305 | when the action is chosen.") | 1471 | menu is selected, and FILTER is a predicate which takes a `custom-variable' |
| 1472 | widget as an argument, and returns non-nil if ACTION is valid on that | ||
| 1473 | widget. 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. |
| 1309 | Optional EVENT is the location for the menu." | 1477 | Optional 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. |
| 1611 | The key is a string containing the name of the action, the value is a | 1793 | Each entry has the form (NAME ACTION FILTER) where NAME is the name of |
| 1612 | lisp function taking the widget as an element which will be called | 1794 | the menu entry, ACTION is the function to call on the widget when the |
| 1613 | when the action is chosen.") | 1795 | menu is selected, and FILTER is a predicate which takes a `custom-face' |
| 1796 | widget as an argument, and returns non-nil if ACTION is valid on that | ||
| 1797 | widget. 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. |
| 1647 | Optional EVENT is the location for the menu." | 1831 | Optional 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. |
| 1874 | The key is a string containing the name of the action, the value is a | 2074 | Each entry has the form (NAME ACTION FILTER) where NAME is the name of |
| 1875 | lisp function taking the widget as an element which will be called | 2075 | the menu entry, ACTION is the function to call on the widget when the |
| 1876 | when the action is chosen.") | 2076 | menu is selected, and FILTER is a predicate which takes a `custom-group' |
| 2077 | widget as an argument, and returns non-nil if ACTION is valid on that | ||
| 2078 | widget. 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. |
| 1880 | Optional EVENT is the location for the menu." | 2082 | Optional 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 |