Mercurial > emacs
comparison lisp/cus-edit.el @ 18067:0e2aa3b58e16
Synched with version 1.9901.
author | Per Abrahamsen <abraham@dina.kvl.dk> |
---|---|
date | Sat, 31 May 1997 06:34:12 +0000 |
parents | fef9a6fc0655 |
children | 3da4eaba1fe8 |
comparison
equal
deleted
inserted
replaced
18066:eecd891e2b63 | 18067:0e2aa3b58e16 |
---|---|
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.9900 | 7 ;; Version: 1.9901 |
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. |
11 | 11 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
515 | 515 |
516 (defcustom custom-buffer-sort-predicate 'custom-buffer-sort-alphabetically | 516 (defcustom custom-buffer-sort-predicate 'custom-buffer-sort-alphabetically |
517 "Function used for sorting group members in buffers. | 517 "Function used for sorting group members in buffers. |
518 The value should be useful as a predicate for `sort'. | 518 The value should be useful as a predicate for `sort'. |
519 The list to be sorted is the value of the groups `custom-group' property." | 519 The list to be sorted is the value of the groups `custom-group' property." |
520 :type '(radio (function-item 'custom-buffer-sort-alphabetically) | 520 :type '(radio (function-item custom-buffer-sort-alphabetically) |
521 (function :tag "Other")) | 521 (function :tag "Other")) |
522 :group 'customize) | 522 :group 'customize) |
523 | 523 |
524 (defun custom-buffer-sort-alphabetically (a b) | 524 (defun custom-buffer-sort-alphabetically (a b) |
525 "Return t iff is A should be before B. | 525 "Return t iff is A should be before B. |
537 | 537 |
538 (defcustom custom-menu-sort-predicate 'custom-menu-sort-alphabetically | 538 (defcustom custom-menu-sort-predicate 'custom-menu-sort-alphabetically |
539 "Function used for sorting group members in menus. | 539 "Function used for sorting group members in menus. |
540 The value should be useful as a predicate for `sort'. | 540 The value should be useful as a predicate for `sort'. |
541 The list to be sorted is the value of the groups `custom-group' property." | 541 The list to be sorted is the value of the groups `custom-group' property." |
542 :type '(radio (function-item 'custom-menu-sort-alphabetically) | 542 :type '(radio (function-item custom-menu-sort-alphabetically) |
543 (function :tag "Other")) | 543 (function :tag "Other")) |
544 :group 'customize) | 544 :group 'customize) |
545 | 545 |
546 (defun custom-menu-sort-alphabetically (a b) | 546 (defun custom-menu-sort-alphabetically (a b) |
547 "Return t iff is A should be before B. | 547 "Return t iff is A should be before B. |
1026 (defconst custom-magic-alist '((nil "#" underline "\ | 1026 (defconst custom-magic-alist '((nil "#" underline "\ |
1027 uninitialized, you should not see this.") | 1027 uninitialized, you should not see this.") |
1028 (unknown "?" italic "\ | 1028 (unknown "?" italic "\ |
1029 unknown, you should not see this.") | 1029 unknown, you should not see this.") |
1030 (hidden "-" default "\ | 1030 (hidden "-" default "\ |
1031 hidden, invoke the state button to show." "\ | 1031 hidden, invoke the dots above to show." "\ |
1032 group now hidden, invoke the state button to show contents.") | 1032 group now hidden, invoke the dots above to show contents.") |
1033 (invalid "x" custom-invalid-face "\ | 1033 (invalid "x" custom-invalid-face "\ |
1034 the value displayed for this item is invalid and cannot be set.") | 1034 the value displayed for this item is invalid and cannot be set.") |
1035 (modified "*" custom-modified-face "\ | 1035 (modified "*" custom-modified-face "\ |
1036 you have edited the item, and can now set it." "\ | 1036 you have edited the item, and can now set it." "\ |
1037 you have edited something in this group, and can now set it.") | 1037 you have edited something in this group, and can now set it.") |
1086 left out, ITEM-DESC will be used. | 1086 left out, ITEM-DESC will be used. |
1087 | 1087 |
1088 The list should be sorted most significant first.") | 1088 The list should be sorted most significant first.") |
1089 | 1089 |
1090 (defcustom custom-magic-show 'long | 1090 (defcustom custom-magic-show 'long |
1091 "Show long description of the state of each customization option." | 1091 "If non-nil, show textual description of the state. |
1092 If non-nil and not the symbol `long', only show first word." | |
1092 :type '(choice (const :tag "no" nil) | 1093 :type '(choice (const :tag "no" nil) |
1093 (const short) | 1094 (const short) |
1094 (const long)) | 1095 (const long)) |
1096 :group 'customize) | |
1097 | |
1098 (defcustom custom-magic-show-hidden nil | |
1099 "If non-nil, also show long state description of hidden options." | |
1100 :type 'boolean | |
1095 :group 'customize) | 1101 :group 'customize) |
1096 | 1102 |
1097 (defcustom custom-magic-show-button nil | 1103 (defcustom custom-magic-show-button nil |
1098 "Show a magic button indicating the state of each customization option." | 1104 "Show a magic button indicating the state of each customization option." |
1099 :type 'boolean | 1105 :type 'boolean |
1116 | 1122 |
1117 (defun custom-magic-value-create (widget) | 1123 (defun custom-magic-value-create (widget) |
1118 ;; Create compact status report for WIDGET. | 1124 ;; Create compact status report for WIDGET. |
1119 (let* ((parent (widget-get widget :parent)) | 1125 (let* ((parent (widget-get widget :parent)) |
1120 (state (widget-get parent :custom-state)) | 1126 (state (widget-get parent :custom-state)) |
1127 (hidden (eq state 'hidden)) | |
1121 (entry (assq state custom-magic-alist)) | 1128 (entry (assq state custom-magic-alist)) |
1122 (magic (nth 1 entry)) | 1129 (magic (nth 1 entry)) |
1123 (face (nth 2 entry)) | 1130 (face (nth 2 entry)) |
1124 (text (or (and (eq (widget-type parent) 'custom-group) | 1131 (text (or (and (eq (widget-type parent) 'custom-group) |
1125 (nth 4 entry)) | 1132 (nth 4 entry)) |
1126 (nth 3 entry))) | 1133 (nth 3 entry))) |
1127 (lisp (eq (widget-get parent :custom-form) 'lisp)) | 1134 (lisp (eq (widget-get parent :custom-form) 'lisp)) |
1128 children) | 1135 children) |
1129 (when custom-magic-show | 1136 (when (and custom-magic-show |
1137 (or custom-magic-show-hidden (not hidden))) | |
1130 (insert " ") | 1138 (insert " ") |
1131 (push (widget-create-child-and-convert | 1139 (push (widget-create-child-and-convert |
1132 widget 'choice-item | 1140 widget 'choice-item |
1133 :help-echo "\ | 1141 :help-echo "\ |
1134 Change the state of this item." | 1142 Change the state of this item." |
1135 :format "%[%t%]" | 1143 :format (if hidden "%t" "%[%t%]") |
1136 :button-prefix 'widget-push-button-prefix | 1144 :button-prefix 'widget-push-button-prefix |
1137 :button-suffix 'widget-push-button-suffix | 1145 :button-suffix 'widget-push-button-suffix |
1138 :mouse-down-action 'widget-magic-mouse-down-action | 1146 :mouse-down-action 'widget-magic-mouse-down-action |
1139 :tag "State") | 1147 :tag "State") |
1140 children) | 1148 children) |
1152 (insert-char ? indent)))) | 1160 (insert-char ? indent)))) |
1153 (push (widget-create-child-and-convert | 1161 (push (widget-create-child-and-convert |
1154 widget 'choice-item | 1162 widget 'choice-item |
1155 :mouse-down-action 'widget-magic-mouse-down-action | 1163 :mouse-down-action 'widget-magic-mouse-down-action |
1156 :button-face face | 1164 :button-face face |
1165 :button-prefix "" | |
1166 :button-suffix "" | |
1157 :help-echo "Change the state." | 1167 :help-echo "Change the state." |
1158 :format "%[%t%]" | 1168 :format (if hidden "%t" "%[%t%]") |
1159 :tag (if lisp | 1169 :tag (if lisp |
1160 (concat "(" magic ")") | 1170 (concat "(" magic ")") |
1161 (concat "[" magic "]"))) | 1171 (concat "[" magic "]"))) |
1162 children) | 1172 children) |
1163 (insert " ")) | 1173 (insert " ")) |
1199 (let* ((buttons (widget-get widget :buttons)) | 1209 (let* ((buttons (widget-get widget :buttons)) |
1200 (state (widget-get widget :custom-state)) | 1210 (state (widget-get widget :custom-state)) |
1201 (level (widget-get widget :custom-level))) | 1211 (level (widget-get widget :custom-level))) |
1202 (cond ((eq escape ?l) | 1212 (cond ((eq escape ?l) |
1203 (when level | 1213 (when level |
1204 (push (widget-create-child-and-convert | 1214 (if (eq state 'hidden) |
1205 widget 'item :format "%v " (make-string level ?*)) | 1215 (insert-char ?- (* 2 level)) |
1206 buttons) | 1216 (insert "/" (make-string (1- (* 2 level)) ?-))))) |
1207 (widget-put widget :buttons buttons))) | 1217 ((eq escape ?e) |
1218 (when (and level (not (eq state 'hidden))) | |
1219 (insert "\n\\" (make-string (1- (* 2 level)) ?-) " " | |
1220 (widget-get widget :tag) " group end ") | |
1221 (insert (make-string (- 75 (current-column)) ?-) "/\n"))) | |
1222 ((eq escape ?-) | |
1223 (when level | |
1224 (if (eq state 'hidden) | |
1225 (insert-char ?- (- 77 (current-column))) | |
1226 (insert (make-string (- 76 (current-column)) ?-) "\\")))) | |
1208 ((eq escape ?L) | 1227 ((eq escape ?L) |
1209 (when (eq state 'hidden) | 1228 (push (widget-create-child-and-convert |
1210 (widget-insert " ..."))) | 1229 widget 'visibility |
1230 :action 'custom-toggle-parent | |
1231 (not (eq state 'hidden))) | |
1232 buttons)) | |
1211 ((eq escape ?m) | 1233 ((eq escape ?m) |
1212 (and (eq (preceding-char) ?\n) | 1234 (and (eq (preceding-char) ?\n) |
1213 (widget-get widget :indent) | 1235 (widget-get widget :indent) |
1214 (insert-char ? (widget-get widget :indent))) | 1236 (insert-char ? (widget-get widget :indent))) |
1215 (let ((magic (widget-create-child-and-convert | 1237 (let ((magic (widget-create-child-and-convert |
1216 widget 'custom-magic nil))) | 1238 widget 'custom-magic nil))) |
1217 (widget-put widget :custom-magic magic) | 1239 (widget-put widget :custom-magic magic) |
1218 (push magic buttons) | 1240 (push magic buttons) |
1219 (widget-put widget :buttons buttons))) | 1241 (widget-put widget :buttons buttons))) |
1220 ((eq escape ?a) | 1242 ((eq escape ?a) |
1221 (let* ((symbol (widget-get widget :value)) | 1243 (unless (eq state 'hidden) |
1222 (links (get symbol 'custom-links)) | 1244 (let* ((symbol (widget-get widget :value)) |
1223 (many (> (length links) 2))) | 1245 (links (get symbol 'custom-links)) |
1224 (when links | 1246 (many (> (length links) 2))) |
1225 (and (eq (preceding-char) ?\n) | 1247 (when links |
1226 (widget-get widget :indent) | 1248 (and (eq (preceding-char) ?\n) |
1227 (insert-char ? (widget-get widget :indent))) | 1249 (widget-get widget :indent) |
1228 (insert "See also ") | 1250 (insert-char ? (widget-get widget :indent))) |
1229 (while links | 1251 (insert "See also ") |
1230 (push (widget-create-child-and-convert widget (car links)) | 1252 (while links |
1231 buttons) | 1253 (push (widget-create-child-and-convert widget (car links)) |
1232 (setq links (cdr links)) | 1254 buttons) |
1233 (cond ((null links) | 1255 (setq links (cdr links)) |
1234 (insert ".\n")) | 1256 (cond ((null links) |
1235 ((null (cdr links)) | 1257 (insert ".\n")) |
1236 (if many | 1258 ((null (cdr links)) |
1237 (insert ", and ") | 1259 (if many |
1238 (insert " and "))) | 1260 (insert ", and ") |
1239 (t | 1261 (insert " and "))) |
1240 (insert ", ")))) | 1262 (t |
1241 (widget-put widget :buttons buttons)))) | 1263 (insert ", ")))) |
1264 (widget-put widget :buttons buttons))))) | |
1242 (t | 1265 (t |
1243 (widget-default-format-handler widget escape))))) | 1266 (widget-default-format-handler widget escape))))) |
1244 | 1267 |
1245 (defun custom-notify (widget &rest args) | 1268 (defun custom-notify (widget &rest args) |
1246 "Keep track of changes." | 1269 "Keep track of changes." |
1327 (cond ((memq state '(invalid modified)) | 1350 (cond ((memq state '(invalid modified)) |
1328 (error "There are unset changes")) | 1351 (error "There are unset changes")) |
1329 ((eq state 'hidden) | 1352 ((eq state 'hidden) |
1330 (widget-put widget :custom-state 'unknown)) | 1353 (widget-put widget :custom-state 'unknown)) |
1331 (t | 1354 (t |
1355 (widget-put widget :documentation-shown nil) | |
1332 (widget-put widget :custom-state 'hidden))) | 1356 (widget-put widget :custom-state 'hidden))) |
1333 (custom-redraw widget))) | 1357 (custom-redraw widget))) |
1358 | |
1359 (defun custom-toggle-parent (widget &rest ignore) | |
1360 "Toggle visibility of parent to WIDGET." | |
1361 (custom-toggle-hide (widget-get widget :parent))) | |
1334 | 1362 |
1335 ;;; The `custom-variable' Widget. | 1363 ;;; The `custom-variable' Widget. |
1336 | 1364 |
1337 (defface custom-variable-sample-face '((t (:underline t))) | 1365 (defface custom-variable-sample-face '((t (:underline t))) |
1338 "Face used for unpushable variable tags." | 1366 "Face used for unpushable variable tags." |
1403 ;; Now we can create the child widget. | 1431 ;; Now we can create the child widget. |
1404 (cond ((eq state 'hidden) | 1432 (cond ((eq state 'hidden) |
1405 ;; Indicate hidden value. | 1433 ;; Indicate hidden value. |
1406 (push (widget-create-child-and-convert | 1434 (push (widget-create-child-and-convert |
1407 widget 'item | 1435 widget 'item |
1408 :format "%{%t%}: ..." | 1436 :format "%{%t%}: " |
1409 :sample-face 'custom-variable-sample-face | 1437 :sample-face 'custom-variable-sample-face |
1410 :tag tag | 1438 :tag tag |
1411 :parent widget) | 1439 :parent widget) |
1412 children)) | 1440 buttons) |
1441 (push (widget-create-child-and-convert | |
1442 widget 'visibility | |
1443 :action 'custom-toggle-parent | |
1444 nil) | |
1445 buttons)) | |
1413 ((eq form 'lisp) | 1446 ((eq form 'lisp) |
1414 ;; In lisp mode edit the saved value when possible. | 1447 ;; In lisp mode edit the saved value when possible. |
1415 (let* ((value (cond ((get symbol 'saved-value) | 1448 (let* ((value (cond ((get symbol 'saved-value) |
1416 (car (get symbol 'saved-value))) | 1449 (car (get symbol 'saved-value))) |
1417 ((get symbol 'standard-value) | 1450 ((get symbol 'standard-value) |
1418 (car (get symbol 'standard-value))) | 1451 (car (get symbol 'standard-value))) |
1419 ((default-boundp symbol) | 1452 ((default-boundp symbol) |
1420 (custom-quote (funcall get symbol))) | 1453 (custom-quote (funcall get symbol))) |
1421 (t | 1454 (t |
1422 (custom-quote (widget-get conv :value)))))) | 1455 (custom-quote (widget-get conv :value)))))) |
1456 (insert (symbol-name symbol) ": ") | |
1457 (push (widget-create-child-and-convert | |
1458 widget 'visibility | |
1459 :action 'custom-toggle-parent | |
1460 t) | |
1461 buttons) | |
1462 (insert " ") | |
1423 (push (widget-create-child-and-convert | 1463 (push (widget-create-child-and-convert |
1424 widget 'sexp | 1464 widget 'sexp |
1425 :button-face 'custom-variable-button-face | 1465 :button-face 'custom-variable-button-face |
1466 :format "%v" | |
1426 :tag (symbol-name symbol) | 1467 :tag (symbol-name symbol) |
1427 :parent widget | 1468 :parent widget |
1428 :value value) | 1469 :value value) |
1429 children))) | 1470 children))) |
1430 (t | 1471 (t |
1431 ;; Edit mode. | 1472 ;; Edit mode. |
1432 (push (widget-create-child-and-convert | 1473 (let* ((format (widget-get type :format)) |
1433 widget type | 1474 tag-format value-format) |
1434 :tag tag | 1475 (unless (string-match ":" format) |
1435 :button-face 'custom-variable-button-face | 1476 (error "Bad format.")) |
1436 :sample-face 'custom-variable-sample-face | 1477 (setq tag-format (substring format 0 (match-end 0))) |
1437 :value value) | 1478 (setq value-format (substring format (match-end 0))) |
1438 children))) | 1479 (push (widget-create-child-and-convert |
1480 widget 'item | |
1481 :format tag-format | |
1482 :action 'custom-tag-action | |
1483 :mouse-down-action 'custom-tag-mouse-down-action | |
1484 :button-face 'custom-variable-button-face | |
1485 :sample-face 'custom-variable-sample-face | |
1486 tag) | |
1487 buttons) | |
1488 (insert " ") | |
1489 (push (widget-create-child-and-convert | |
1490 widget 'visibility | |
1491 :action 'custom-toggle-parent | |
1492 t) | |
1493 buttons) | |
1494 (push (widget-create-child-and-convert | |
1495 widget type | |
1496 :format value-format | |
1497 :value value) | |
1498 children)))) | |
1439 ;; Now update the state. | 1499 ;; Now update the state. |
1440 (unless (eq (preceding-char) ?\n) | 1500 (unless (eq (preceding-char) ?\n) |
1441 (widget-insert "\n")) | 1501 (widget-insert "\n")) |
1442 (if (eq state 'hidden) | 1502 (if (eq state 'hidden) |
1443 (widget-put widget :custom-state state) | 1503 (widget-put widget :custom-state state) |
1444 (custom-variable-state-set widget)) | 1504 (custom-variable-state-set widget)) |
1445 (widget-put widget :custom-form form) | 1505 (widget-put widget :custom-form form) |
1446 (widget-put widget :buttons buttons) | 1506 (widget-put widget :buttons buttons) |
1447 (widget-put widget :children children))) | 1507 (widget-put widget :children children))) |
1508 | |
1509 (defun custom-tag-action (widget &rest args) | |
1510 "Pass :action to first child of WIDGET's parent." | |
1511 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children)) | |
1512 :action args)) | |
1513 | |
1514 (defun custom-tag-mouse-down-action (widget &rest args) | |
1515 "Pass :mouse-down-action to first child of WIDGET's parent." | |
1516 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children)) | |
1517 :mouse-down-action args)) | |
1448 | 1518 |
1449 (defun custom-variable-state-set (widget) | 1519 (defun custom-variable-state-set (widget) |
1450 "Set the state of WIDGET." | 1520 "Set the state of WIDGET." |
1451 (let* ((symbol (widget-value widget)) | 1521 (let* ((symbol (widget-value widget)) |
1452 (get (or (get symbol 'custom-get) 'default-value)) | 1522 (get (or (get symbol 'custom-get) 'default-value)) |
1474 'changed)) | 1544 'changed)) |
1475 (t 'rogue)))) | 1545 (t 'rogue)))) |
1476 (widget-put widget :custom-state state))) | 1546 (widget-put widget :custom-state state))) |
1477 | 1547 |
1478 (defvar custom-variable-menu | 1548 (defvar custom-variable-menu |
1479 '(("Hide" custom-toggle-hide | 1549 '(("Edit" custom-variable-edit |
1480 (lambda (widget) | |
1481 (not (memq (widget-get widget :custom-state) '(modified invalid))))) | |
1482 ("Edit" custom-variable-edit | |
1483 (lambda (widget) | 1550 (lambda (widget) |
1484 (not (eq (widget-get widget :custom-form) 'edit)))) | 1551 (not (eq (widget-get widget :custom-form) 'edit)))) |
1485 ("Edit Lisp" custom-variable-edit-lisp | 1552 ("Edit Lisp" custom-variable-edit-lisp |
1486 (lambda (widget) | 1553 (lambda (widget) |
1487 (not (eq (widget-get widget :custom-form) 'lisp)))) | 1554 (not (eq (widget-get widget :custom-form) 'lisp)))) |
1710 "Face used for face tags." | 1777 "Face used for face tags." |
1711 :group 'custom-faces) | 1778 :group 'custom-faces) |
1712 | 1779 |
1713 (define-widget 'custom-face 'custom | 1780 (define-widget 'custom-face 'custom |
1714 "Customize face." | 1781 "Customize face." |
1715 :format "%{%t%}: %s%m%h%a%v" | 1782 :format "%{%t%}: %s %L\n%m%h%a%v" |
1716 :format-handler 'custom-face-format-handler | 1783 :format-handler 'custom-face-format-handler |
1717 :sample-face 'custom-face-tag-face | 1784 :sample-face 'custom-face-tag-face |
1718 :help-echo "Set or reset this face." | 1785 :help-echo "Set or reset this face." |
1719 :documentation-property '(lambda (face) | 1786 :documentation-property '(lambda (face) |
1720 (face-doc-string face)) | 1787 (face-doc-string face)) |
1737 ;; XEmacs cannot display initialized faces. | 1804 ;; XEmacs cannot display initialized faces. |
1738 (not (custom-facep symbol)) | 1805 (not (custom-facep symbol)) |
1739 (copy-face 'custom-face-empty symbol)) | 1806 (copy-face 'custom-face-empty symbol)) |
1740 (setq child (widget-create-child-and-convert | 1807 (setq child (widget-create-child-and-convert |
1741 widget 'item | 1808 widget 'item |
1742 :format "(%{%t%})\n" | 1809 :format "(%{%t%})" |
1743 :sample-face symbol | 1810 :sample-face symbol |
1744 :tag "sample"))) | 1811 :tag "sample"))) |
1745 (t | 1812 (t |
1746 (custom-format-handler widget escape))) | 1813 (custom-format-handler widget escape))) |
1747 (when child | 1814 (when child |
1811 (custom-face-state-set widget) | 1878 (custom-face-state-set widget) |
1812 (widget-put widget :children (list edit))) | 1879 (widget-put widget :children (list edit))) |
1813 (message "Creating face editor...done"))) | 1880 (message "Creating face editor...done"))) |
1814 | 1881 |
1815 (defvar custom-face-menu | 1882 (defvar custom-face-menu |
1816 '(("Hide" custom-toggle-hide | 1883 '(("Edit Selected" custom-face-edit-selected |
1817 (lambda (widget) | |
1818 (not (memq (widget-get widget :custom-state) '(modified invalid))))) | |
1819 ("Edit Selected" custom-face-edit-selected | |
1820 (lambda (widget) | 1884 (lambda (widget) |
1821 (not (eq (widget-get widget :custom-form) 'selected)))) | 1885 (not (eq (widget-get widget :custom-form) 'selected)))) |
1822 ("Edit All" custom-face-edit-all | 1886 ("Edit All" custom-face-edit-all |
1823 (lambda (widget) | 1887 (lambda (widget) |
1824 (not (eq (widget-get widget :custom-form) 'all)))) | 1888 (not (eq (widget-get widget :custom-form) 'all)))) |
1953 (defun widget-face-value-create (widget) | 2017 (defun widget-face-value-create (widget) |
1954 ;; Create a `custom-face' child. | 2018 ;; Create a `custom-face' child. |
1955 (let* ((symbol (widget-value widget)) | 2019 (let* ((symbol (widget-value widget)) |
1956 (child (widget-create-child-and-convert | 2020 (child (widget-create-child-and-convert |
1957 widget 'custom-face | 2021 widget 'custom-face |
1958 :format "%t %s%m%h%v" | 2022 :format "%t %s %L\n%m%h%v" |
1959 :custom-level nil | 2023 :custom-level nil |
1960 :value symbol))) | 2024 :value symbol))) |
1961 (custom-magic-reset child) | 2025 (custom-magic-reset child) |
1962 (setq custom-options (cons child custom-options)) | 2026 (setq custom-options (cons child custom-options)) |
1963 (widget-put widget :children (list child)))) | 2027 (widget-put widget :children (list child)))) |
2037 "Face used for low level group tags." | 2101 "Face used for low level group tags." |
2038 :group 'custom-faces) | 2102 :group 'custom-faces) |
2039 | 2103 |
2040 (define-widget 'custom-group 'custom | 2104 (define-widget 'custom-group 'custom |
2041 "Customize group." | 2105 "Customize group." |
2042 :format "%l%{%t%}:%L\n%m%h%a%v" | 2106 :format "%l %{%t%} group: %L %-\n%m%h%a%v%e" |
2043 :sample-face-get 'custom-group-sample-face-get | 2107 :sample-face-get 'custom-group-sample-face-get |
2044 :documentation-property 'group-documentation | 2108 :documentation-property 'group-documentation |
2045 :help-echo "Set or reset all members of this group." | 2109 :help-echo "Set or reset all members of this group." |
2046 :value-create 'custom-group-value-create | 2110 :value-create 'custom-group-value-create |
2047 :action 'custom-group-action | 2111 :action 'custom-group-action |
2094 (widget-put widget :children children) | 2158 (widget-put widget :children children) |
2095 (custom-group-state-update widget) | 2159 (custom-group-state-update widget) |
2096 (message "Creating group... done"))))) | 2160 (message "Creating group... done"))))) |
2097 | 2161 |
2098 (defvar custom-group-menu | 2162 (defvar custom-group-menu |
2099 '(("Hide" custom-toggle-hide | 2163 '(("Set" custom-group-set |
2100 (lambda (widget) | |
2101 (not (memq (widget-get widget :custom-state) '(modified invalid))))) | |
2102 ("Set" custom-group-set | |
2103 (lambda (widget) | 2164 (lambda (widget) |
2104 (eq (widget-get widget :custom-state) 'modified))) | 2165 (eq (widget-get widget :custom-state) 'modified))) |
2105 ("Save" custom-group-save | 2166 ("Save" custom-group-save |
2106 (lambda (widget) | 2167 (lambda (widget) |
2107 (memq (widget-get widget :custom-state) '(modified set)))) | 2168 (memq (widget-get widget :custom-state) '(modified set)))) |