diff options
| author | Richard M. Stallman | 1997-06-24 22:42:54 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-06-24 22:42:54 +0000 |
| commit | b62c92bb795d0b25107e47a9d1f645a71655d555 (patch) | |
| tree | 83804f5079fa7998341915866f02e7dccfbb1113 | |
| parent | f9dd586e0f41e5ca9d153534c3c9a5373fccb585 (diff) | |
| download | emacs-b62c92bb795d0b25107e47a9d1f645a71655d555.tar.gz emacs-b62c92bb795d0b25107e47a9d1f645a71655d555.zip | |
(custom-documentation-face): New face.
(custom-mode): Use custom-documentation-face for doc strings.
(custom-group-link): Fix the help string.
(custom-magic-show): Doc fix.
(custom-group-value-create): In links style,
use Go to Group instead of Show.
(Custom-goto-parent): New command.
(custom-mode-map): Bind u to Custom-goto-parent.
Bind SPC and DEL.
(custom-buffer-create-internal): Improve help for buttons.
(custom-button-face): New defface.
(custom widget-type): Use custom-button-face for buttons.
(custom-group-tag-faces): Initial value is nil.
(custom-variable-tag-face): Renamed from custom-variable-sample-face.
Initialize it like custom-group-tag-face.
(custom-group-tag-faces): Initialize to nil.
(custom-state-face): New defface.
(custom-magic-value-create):
Use custom-state-face for long State descriptions.
(custom-state-buffer-message): Display the message
only if the item is modified. Take widget as arg.
(custom-mode): Use widget-edit-functions.
| -rw-r--r-- | lisp/cus-edit.el | 99 |
1 files changed, 72 insertions, 27 deletions
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 433308c3f3e..abf575cf968 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -992,14 +992,15 @@ on an active field to invoke its action. Invoke ") | |||
| 992 | (widget-insert "Operate on everything in this buffer:\n ") | 992 | (widget-insert "Operate on everything in this buffer:\n ") |
| 993 | (widget-create 'push-button | 993 | (widget-create 'push-button |
| 994 | :tag "Set" | 994 | :tag "Set" |
| 995 | :help-echo "Set all modifications for this session." | 995 | :help-echo "\ |
| 996 | Make your editing in this buffer take effect for this session." | ||
| 996 | :action (lambda (widget &optional event) | 997 | :action (lambda (widget &optional event) |
| 997 | (Custom-set))) | 998 | (Custom-set))) |
| 998 | (widget-insert " ") | 999 | (widget-insert " ") |
| 999 | (widget-create 'push-button | 1000 | (widget-create 'push-button |
| 1000 | :tag "Save" | 1001 | :tag "Save" |
| 1001 | :help-echo "\ | 1002 | :help-echo "\ |
| 1002 | Make the modifications default for future sessions." | 1003 | Make your editing in this buffer take effect for future Emacs sessions." |
| 1003 | :action (lambda (widget &optional event) | 1004 | :action (lambda (widget &optional event) |
| 1004 | (Custom-save))) | 1005 | (Custom-save))) |
| 1005 | (widget-insert " ") | 1006 | (widget-insert " ") |
| @@ -1013,19 +1014,19 @@ Make the modifications default for future sessions." | |||
| 1013 | (widget-create 'push-button | 1014 | (widget-create 'push-button |
| 1014 | :tag "Reset" | 1015 | :tag "Reset" |
| 1015 | :help-echo "\ | 1016 | :help-echo "\ |
| 1016 | Reset all visible items in this buffer to their current settings." | 1017 | Reset all edited text in this buffer to reflect current values." |
| 1017 | :action 'Custom-reset-current) | 1018 | :action 'Custom-reset-current) |
| 1018 | (widget-insert " ") | 1019 | (widget-insert " ") |
| 1019 | (widget-create 'push-button | 1020 | (widget-create 'push-button |
| 1020 | :tag "Reset to Saved" | 1021 | :tag "Reset to Saved" |
| 1021 | :help-echo "\ | 1022 | :help-echo "\ |
| 1022 | Reset all visible items in this buffer to their saved settings." | 1023 | Reset all values in this buffer to their saved settings." |
| 1023 | :action 'Custom-reset-saved) | 1024 | :action 'Custom-reset-saved) |
| 1024 | (widget-insert " ") | 1025 | (widget-insert " ") |
| 1025 | (widget-create 'push-button | 1026 | (widget-create 'push-button |
| 1026 | :tag "Reset to Standard" | 1027 | :tag "Reset to Standard" |
| 1027 | :help-echo "\ | 1028 | :help-echo "\ |
| 1028 | Reset all visible items in this buffer to their standard settings." | 1029 | Reset all values in this buffer to their standard settings." |
| 1029 | :action 'Custom-reset-standard)) | 1030 | :action 'Custom-reset-standard)) |
| 1030 | (widget-insert " ") | 1031 | (widget-insert " ") |
| 1031 | (widget-create 'push-button | 1032 | (widget-create 'push-button |
| @@ -1270,22 +1271,22 @@ The list should be sorted most significant first.") | |||
| 1270 | 1271 | ||
| 1271 | (defcustom custom-magic-show 'long | 1272 | (defcustom custom-magic-show 'long |
| 1272 | "If non-nil, show textual description of the state. | 1273 | "If non-nil, show textual description of the state. |
| 1273 | If non-nil and not the symbol `long', only show first word." | 1274 | If `long', show a full-line description, not just one word." |
| 1274 | :type '(choice (const :tag "no" nil) | 1275 | :type '(choice (const :tag "no" nil) |
| 1275 | (const short) | 1276 | (const short) |
| 1276 | (const long)) | 1277 | (const long)) |
| 1277 | :group 'custom-buffer) | 1278 | :group 'custom-buffer) |
| 1278 | 1279 | ||
| 1279 | (defcustom custom-magic-show-hidden '(option face) | 1280 | (defcustom custom-magic-show-hidden '(option face) |
| 1280 | "Control whether the state button is shown for hidden items. | 1281 | "Control whether the State button is shown for hidden items. |
| 1281 | The value should be a list with the custom categories where the state | 1282 | The value should be a list with the custom categories where the State |
| 1282 | button should be visible. Possible categories are `group', `option', | 1283 | button should be visible. Possible categories are `group', `option', |
| 1283 | and `face'." | 1284 | and `face'." |
| 1284 | :type '(set (const group) (const option) (const face)) | 1285 | :type '(set (const group) (const option) (const face)) |
| 1285 | :group 'custom-buffer) | 1286 | :group 'custom-buffer) |
| 1286 | 1287 | ||
| 1287 | (defcustom custom-magic-show-button nil | 1288 | (defcustom custom-magic-show-button nil |
| 1288 | "Show a magic button indicating the state of each customization option." | 1289 | "Show a \"magic\" button indicating the state of each customization option." |
| 1289 | :type 'boolean | 1290 | :type 'boolean |
| 1290 | :group 'custom-buffer) | 1291 | :group 'custom-buffer) |
| 1291 | 1292 | ||
| @@ -1341,11 +1342,13 @@ and `face'." | |||
| 1341 | :tag "State") | 1342 | :tag "State") |
| 1342 | children) | 1343 | children) |
| 1343 | (insert ": ") | 1344 | (insert ": ") |
| 1344 | (if (eq custom-magic-show 'long) | 1345 | (let ((start (point))) |
| 1345 | (insert text) | 1346 | (if (eq custom-magic-show 'long) |
| 1346 | (insert (symbol-name state))) | 1347 | (insert text) |
| 1347 | (when lisp | 1348 | (insert (symbol-name state))) |
| 1348 | (insert " (lisp)")) | 1349 | (when lisp |
| 1350 | (insert " (lisp)")) | ||
| 1351 | (put-text-property start (point) 'face 'custom-state-face)) | ||
| 1349 | (insert "\n")) | 1352 | (insert "\n")) |
| 1350 | (when (and (eq category 'group) | 1353 | (when (and (eq category 'group) |
| 1351 | (not (and (eq custom-buffer-style 'links) | 1354 | (not (and (eq custom-buffer-style 'links) |
| @@ -1379,6 +1382,24 @@ and `face'." | |||
| 1379 | 1382 | ||
| 1380 | ;;; The `custom' Widget. | 1383 | ;;; The `custom' Widget. |
| 1381 | 1384 | ||
| 1385 | (defface custom-button-face nil | ||
| 1386 | "Face used for buttons in customization buffers." | ||
| 1387 | :group 'custom-faces) | ||
| 1388 | |||
| 1389 | (defface custom-documentation-face nil | ||
| 1390 | "Face used for documentation strings in customization buffers." | ||
| 1391 | :group 'custom-faces) | ||
| 1392 | |||
| 1393 | (defface custom-state-face '((((class color) | ||
| 1394 | (background dark)) | ||
| 1395 | (:foreground "lime green")) | ||
| 1396 | (((class color) | ||
| 1397 | (background light)) | ||
| 1398 | (:foreground "dark green")) | ||
| 1399 | (t nil)) | ||
| 1400 | "Face used for State descriptions in the customize buffer." | ||
| 1401 | :group 'custom-faces) | ||
| 1402 | |||
| 1382 | (define-widget 'custom 'default | 1403 | (define-widget 'custom 'default |
| 1383 | "Customize a user option." | 1404 | "Customize a user option." |
| 1384 | :format "%v" | 1405 | :format "%v" |
| @@ -1392,6 +1413,7 @@ and `face'." | |||
| 1392 | :value-delete 'widget-children-value-delete | 1413 | :value-delete 'widget-children-value-delete |
| 1393 | :value-get 'widget-value-value-get | 1414 | :value-get 'widget-value-value-get |
| 1394 | :validate 'widget-children-validate | 1415 | :validate 'widget-children-validate |
| 1416 | :button-face 'custom-button-face | ||
| 1395 | :match (lambda (widget value) (symbolp value))) | 1417 | :match (lambda (widget value) (symbolp value))) |
| 1396 | 1418 | ||
| 1397 | (defun custom-convert-widget (widget) | 1419 | (defun custom-convert-widget (widget) |
| @@ -1500,7 +1522,7 @@ and `face'." | |||
| 1500 | (widget-setup))) | 1522 | (widget-setup))) |
| 1501 | 1523 | ||
| 1502 | (defun custom-toggle-parent (widget &rest ignore) | 1524 | (defun custom-toggle-parent (widget &rest ignore) |
| 1503 | "Toggle visibility of parent to WIDGET." | 1525 | "Toggle visibility of parent of WIDGET." |
| 1504 | (custom-toggle-hide (widget-get widget :parent))) | 1526 | (custom-toggle-hide (widget-get widget :parent))) |
| 1505 | 1527 | ||
| 1506 | (defun custom-add-see-also (widget &optional prefix) | 1528 | (defun custom-add-see-also (widget &optional prefix) |
| @@ -1560,7 +1582,13 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." | |||
| 1560 | 1582 | ||
| 1561 | ;;; The `custom-variable' Widget. | 1583 | ;;; The `custom-variable' Widget. |
| 1562 | 1584 | ||
| 1563 | (defface custom-variable-sample-face '((t (:underline t))) | 1585 | (defface custom-variable-tag-face '((((class color) |
| 1586 | (background dark)) | ||
| 1587 | (:foreground "light blue" :underline t)) | ||
| 1588 | (((class color) | ||
| 1589 | (background light)) | ||
| 1590 | (:foreground "blue" :underline t)) | ||
| 1591 | (t (:underline t))) | ||
| 1564 | "Face used for unpushable variable tags." | 1592 | "Face used for unpushable variable tags." |
| 1565 | :group 'custom-faces) | 1593 | :group 'custom-faces) |
| 1566 | 1594 | ||
| @@ -1642,7 +1670,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'." | |||
| 1642 | (push (widget-create-child-and-convert | 1670 | (push (widget-create-child-and-convert |
| 1643 | widget 'item | 1671 | widget 'item |
| 1644 | :format "%{%t%}: " | 1672 | :format "%{%t%}: " |
| 1645 | :sample-face 'custom-variable-sample-face | 1673 | :sample-face 'custom-variable-tag-face |
| 1646 | :tag tag | 1674 | :tag tag |
| 1647 | :parent widget) | 1675 | :parent widget) |
| 1648 | buttons) | 1676 | buttons) |
| @@ -1693,7 +1721,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'." | |||
| 1693 | :help-echo "Change value of this option." | 1721 | :help-echo "Change value of this option." |
| 1694 | :mouse-down-action 'custom-tag-mouse-down-action | 1722 | :mouse-down-action 'custom-tag-mouse-down-action |
| 1695 | :button-face 'custom-variable-button-face | 1723 | :button-face 'custom-variable-button-face |
| 1696 | :sample-face 'custom-variable-sample-face | 1724 | :sample-face 'custom-variable-tag-face |
| 1697 | tag) | 1725 | tag) |
| 1698 | buttons) | 1726 | buttons) |
| 1699 | (insert " ") | 1727 | (insert " ") |
| @@ -2343,7 +2371,7 @@ Optional EVENT is the location for the menu." | |||
| 2343 | 2371 | ||
| 2344 | (define-widget 'custom-group-link 'link | 2372 | (define-widget 'custom-group-link 'link |
| 2345 | "Show parent in other window when activated." | 2373 | "Show parent in other window when activated." |
| 2346 | :help-echo "Create customize buffer for this group group." | 2374 | :help-echo "Create customization buffer for this group." |
| 2347 | :action 'custom-group-link-action) | 2375 | :action 'custom-group-link-action) |
| 2348 | 2376 | ||
| 2349 | (defun custom-group-link-action (widget &rest ignore) | 2377 | (defun custom-group-link-action (widget &rest ignore) |
| @@ -2351,7 +2379,7 @@ Optional EVENT is the location for the menu." | |||
| 2351 | 2379 | ||
| 2352 | ;;; The `custom-group' Widget. | 2380 | ;;; The `custom-group' Widget. |
| 2353 | 2381 | ||
| 2354 | (defcustom custom-group-tag-faces '(custom-group-tag-face-1) | 2382 | (defcustom custom-group-tag-faces nil |
| 2355 | ;; In XEmacs, this ought to play games with font size. | 2383 | ;; In XEmacs, this ought to play games with font size. |
| 2356 | "Face used for group tags. | 2384 | "Face used for group tags. |
| 2357 | The first member is used for level 1 groups, the second for level 2, | 2385 | The first member is used for level 1 groups, the second for level 2, |
| @@ -2500,7 +2528,7 @@ and so forth. The remaining group tags are shown with | |||
| 2500 | (if (eq custom-buffer-style 'links) | 2528 | (if (eq custom-buffer-style 'links) |
| 2501 | (push (widget-create-child-and-convert | 2529 | (push (widget-create-child-and-convert |
| 2502 | widget 'custom-group-link | 2530 | widget 'custom-group-link |
| 2503 | :tag "Show" | 2531 | :tag "Go to Group" |
| 2504 | symbol) | 2532 | symbol) |
| 2505 | buttons) | 2533 | buttons) |
| 2506 | (push (widget-create-child-and-convert | 2534 | (push (widget-create-child-and-convert |
| @@ -2966,12 +2994,15 @@ The format is suitable for use with `easy-menu-define'." | |||
| 2966 | 2994 | ||
| 2967 | (defvar custom-mode-map nil | 2995 | (defvar custom-mode-map nil |
| 2968 | "Keymap for `custom-mode'.") | 2996 | "Keymap for `custom-mode'.") |
| 2969 | 2997 | ||
| 2970 | (unless custom-mode-map | 2998 | (unless custom-mode-map |
| 2971 | (setq custom-mode-map (make-sparse-keymap)) | 2999 | (setq custom-mode-map (make-sparse-keymap)) |
| 2972 | (set-keymap-parent custom-mode-map widget-keymap) | 3000 | (set-keymap-parent custom-mode-map widget-keymap) |
| 2973 | (suppress-keymap custom-mode-map) | 3001 | (suppress-keymap custom-mode-map) |
| 2974 | (define-key custom-mode-map "q" 'bury-buffer)) | 3002 | (define-key custom-mode-map " " 'scroll-up) |
| 3003 | (define-key custom-mode-map "\177" 'scroll-down) | ||
| 3004 | (define-key custom-mode-map "q" 'bury-buffer) | ||
| 3005 | (define-key custom-mode-map "u" 'Custom-goto-parent)) | ||
| 2975 | 3006 | ||
| 2976 | (easy-menu-define Custom-mode-menu | 3007 | (easy-menu-define Custom-mode-menu |
| 2977 | custom-mode-map | 3008 | custom-mode-map |
| @@ -2985,13 +3016,25 @@ The format is suitable for use with `easy-menu-define'." | |||
| 2985 | ["Reset to Standard Settings" Custom-reset-standard t] | 3016 | ["Reset to Standard Settings" Custom-reset-standard t] |
| 2986 | ["Info" (Info-goto-node "(custom)The Customization Buffer") t])) | 3017 | ["Info" (Info-goto-node "(custom)The Customization Buffer") t])) |
| 2987 | 3018 | ||
| 3019 | (defun Custom-goto-parent () | ||
| 3020 | "Go to the parent group listed at the top of this buffer. | ||
| 3021 | If several parents are listed, go to the first of them." | ||
| 3022 | (interactive) | ||
| 3023 | (save-excursion | ||
| 3024 | (goto-char (point-min)) | ||
| 3025 | (if (search-forward "\nGo to parent group: " nil t) | ||
| 3026 | (let* ((button (get-char-property (point) 'button)) | ||
| 3027 | (parent (downcase (widget-get button :tag)))) | ||
| 3028 | (customize-group parent))))) | ||
| 3029 | |||
| 2988 | (defcustom custom-mode-hook nil | 3030 | (defcustom custom-mode-hook nil |
| 2989 | "Hook called when entering custom-mode." | 3031 | "Hook called when entering custom-mode." |
| 2990 | :type 'hook | 3032 | :type 'hook |
| 2991 | :group 'custom-buffer ) | 3033 | :group 'custom-buffer ) |
| 2992 | 3034 | ||
| 2993 | (defun custom-state-buffer-message () | 3035 | (defun custom-state-buffer-message (widget) |
| 2994 | (message "To set the value, invoke [State] and choose the Set operation")) | 3036 | (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified) |
| 3037 | (message "To install your edits, invoke [State] and choose the Set operation"))) | ||
| 2995 | 3038 | ||
| 2996 | (defun custom-mode () | 3039 | (defun custom-mode () |
| 2997 | "Major mode for editing customization buffers. | 3040 | "Major mode for editing customization buffers. |
| @@ -3016,8 +3059,10 @@ if that value is non-nil." | |||
| 3016 | (use-local-map custom-mode-map) | 3059 | (use-local-map custom-mode-map) |
| 3017 | (easy-menu-add Custom-mode-menu) | 3060 | (easy-menu-add Custom-mode-menu) |
| 3018 | (make-local-variable 'custom-options) | 3061 | (make-local-variable 'custom-options) |
| 3019 | (make-local-hook 'widget-edit-hook) | 3062 | (make-local-variable 'widget-documentation-face) |
| 3020 | (add-hook 'widget-edit-hook 'custom-state-buffer-message nil t) | 3063 | (setq widget-documentation-face 'custom-documentation-face) |
| 3064 | (make-local-hook 'widget-edit-functions) | ||
| 3065 | (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) | ||
| 3021 | (run-hooks 'custom-mode-hook)) | 3066 | (run-hooks 'custom-mode-hook)) |
| 3022 | 3067 | ||
| 3023 | ;;; The End. | 3068 | ;;; The End. |