Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-edit.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 1917ad0d78d7
children e04119814345
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
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.50 7 ;; Version: 1.59
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;;; Commentary: 10 ;;; Commentary:
11 ;; 11 ;;
12 ;; See `custom.el'. 12 ;; See `custom.el'.
298 (defvar custom-mode-map nil 298 (defvar custom-mode-map nil
299 "Keymap for `custom-mode'.") 299 "Keymap for `custom-mode'.")
300 300
301 (unless custom-mode-map 301 (unless custom-mode-map
302 (setq custom-mode-map (make-sparse-keymap)) 302 (setq custom-mode-map (make-sparse-keymap))
303 (set-keymap-parent custom-mode-map widget-keymap)) 303 (set-keymap-parent custom-mode-map widget-keymap)
304 (define-key custom-mode-map "q" 'bury-buffer))
304 305
305 (easy-menu-define custom-mode-menu 306 (easy-menu-define custom-mode-menu
306 custom-mode-map 307 custom-mode-map
307 "Menu used in customization buffers." 308 "Menu used in customization buffers."
308 '("Custom" 309 '("Custom"
516 (custom-mode) 517 (custom-mode)
517 (widget-insert "This is a customization buffer. 518 (widget-insert "This is a customization buffer.
518 Push RET or click mouse-2 on the word ") 519 Push RET or click mouse-2 on the word ")
519 (widget-create 'info-link 520 (widget-create 'info-link
520 :tag "help" 521 :tag "help"
521 :help-echo "Push me for help." 522 :help-echo "Read the online help."
522 "(custom)The Customization Buffer") 523 "(custom)The Customization Buffer")
523 (widget-insert " for more information.\n\n") 524 (widget-insert " for more information.\n\n")
524 (setq custom-options 525 (setq custom-options
525 (mapcar (lambda (entry) 526 (mapcar (lambda (entry)
526 (prog1 527 (prog1
540 (widget-insert "\n"))) 541 (widget-insert "\n")))
541 options)) 542 options))
542 (mapcar 'custom-magic-reset custom-options) 543 (mapcar 'custom-magic-reset custom-options)
543 (widget-create 'push-button 544 (widget-create 'push-button
544 :tag "Set" 545 :tag "Set"
545 :help-echo "Push me to set all modifications." 546 :help-echo "Set all modifications for this session."
546 :action (lambda (widget &optional event) 547 :action (lambda (widget &optional event)
547 (custom-set))) 548 (custom-set)))
548 (widget-insert " ") 549 (widget-insert " ")
549 (widget-create 'push-button 550 (widget-create 'push-button
550 :tag "Save" 551 :tag "Save"
551 :help-echo "Push me to make the modifications default." 552 :help-echo "\
553 Make the modifications default for future sessions."
552 :action (lambda (widget &optional event) 554 :action (lambda (widget &optional event)
553 (custom-save))) 555 (custom-save)))
554 (widget-insert " ") 556 (widget-insert " ")
555 (widget-create 'push-button 557 (widget-create 'push-button
556 :tag "Reset" 558 :tag "Reset"
557 :help-echo "Push me to undo all modifications." 559 :help-echo "Undo all modifications."
558 :action (lambda (widget &optional event) 560 :action (lambda (widget &optional event)
559 (custom-reset event))) 561 (custom-reset event)))
560 (widget-insert " ") 562 (widget-insert " ")
561 (widget-create 'push-button 563 (widget-create 'push-button
562 :tag "Done" 564 :tag "Done"
563 :help-echo "Push me to bury the buffer." 565 :help-echo "Bury the buffer."
564 :action (lambda (widget &optional event) 566 :action (lambda (widget &optional event)
565 (bury-buffer) 567 (bury-buffer)
566 ;; Steal button release event. 568 ;; Steal button release event.
567 (if (and (fboundp 'button-press-event-p) 569 (if (and (fboundp 'button-press-event-p)
568 (fboundp 'next-command-event)) 570 (fboundp 'next-command-event))
572 (next-command-event)) 574 (next-command-event))
573 ;; Emacs 575 ;; Emacs
574 (when (memq 'down (event-modifiers event)) 576 (when (memq 'down (event-modifiers event))
575 (read-event))))) 577 (read-event)))))
576 (widget-insert "\n") 578 (widget-insert "\n")
577 (widget-setup)) 579 (widget-setup)
580 (goto-char (point-min)))
578 581
579 ;;; Modification of Basic Widgets. 582 ;;; Modification of Basic Widgets.
580 ;; 583 ;;
581 ;; We add extra properties to the basic widgets needed here. This is 584 ;; We add extra properties to the basic widgets needed here. This is
582 ;; fine, as long as we are careful to stay within out own namespace. 585 ;; fine, as long as we are careful to stay within out own namespace.
597 600
598 ;;; The `custom-manual' Widget. 601 ;;; The `custom-manual' Widget.
599 602
600 (define-widget 'custom-manual 'info-link 603 (define-widget 'custom-manual 'info-link
601 "Link to the manual entry for this customization option." 604 "Link to the manual entry for this customization option."
602 :help-echo "Push me to read the manual." 605 :help-echo "Read the manual entry for this option."
603 :tag "Manual") 606 :tag "Manual")
604 607
605 ;;; The `custom-magic' Widget. 608 ;;; The `custom-magic' Widget.
606 609
607 (defface custom-invalid-face '((((class color)) 610 (defface custom-invalid-face '((((class color))
769 (lisp (eq (widget-get parent :custom-form) 'lisp)) 772 (lisp (eq (widget-get parent :custom-form) 'lisp))
770 children) 773 children)
771 (when custom-magic-show 774 (when custom-magic-show
772 (push (widget-create-child-and-convert widget 'choice-item 775 (push (widget-create-child-and-convert widget 'choice-item
773 :help-echo "\ 776 :help-echo "\
774 Push me to change the state of this item." 777 Change the state of this item."
775 :format "%[%t%]" 778 :format "%[%t%]"
776 :tag "State") 779 :tag "State")
777 children) 780 children)
778 (insert ": ") 781 (insert ": ")
779 (if (eq custom-magic-show 'long) 782 (if (eq custom-magic-show 'long)
787 (let ((indent (widget-get parent :indent))) 790 (let ((indent (widget-get parent :indent)))
788 (when indent 791 (when indent
789 (insert-char ? indent)))) 792 (insert-char ? indent))))
790 (push (widget-create-child-and-convert widget 'choice-item 793 (push (widget-create-child-and-convert widget 'choice-item
791 :button-face face 794 :button-face face
792 :help-echo "\ 795 :help-echo "Change the state."
793 Push me to change the state."
794 :format "%[%t%]" 796 :format "%[%t%]"
795 :tag (if lisp 797 :tag (if lisp
796 (concat "(" magic ")") 798 (concat "(" magic ")")
797 (concat "[" magic "]"))) 799 (concat "[" magic "]")))
798 children) 800 children)
807 ;;; The `custom-level' Widget. 809 ;;; The `custom-level' Widget.
808 810
809 (define-widget 'custom-level 'item 811 (define-widget 'custom-level 'item
810 "The custom level buttons." 812 "The custom level buttons."
811 :format "%[%t%]" 813 :format "%[%t%]"
812 :help-echo "Push me to expand or collapse this item." 814 :help-echo "Expand or collapse this item."
813 :action 'custom-level-action) 815 :action 'custom-level-action)
814 816
815 (defun custom-level-action (widget &optional event) 817 (defun custom-level-action (widget &optional event)
816 "Toggle visibility for parent to WIDGET." 818 "Toggle visibility for parent to WIDGET."
817 (let* ((parent (widget-get widget :parent)) 819 (let* ((parent (widget-get widget :parent))
900 (t 902 (t
901 (widget-default-format-handler widget escape))))) 903 (widget-default-format-handler widget escape)))))
902 904
903 (defun custom-notify (widget &rest args) 905 (defun custom-notify (widget &rest args)
904 "Keep track of changes." 906 "Keep track of changes."
905 (widget-put widget :custom-state 'modified) 907 (unless (memq (widget-get widget :custom-state) '(nil unknown hidden))
908 (widget-put widget :custom-state 'modified))
906 (let ((buffer-undo-list t)) 909 (let ((buffer-undo-list t))
907 (custom-magic-reset widget)) 910 (custom-magic-reset widget))
908 (apply 'widget-default-notify widget args)) 911 (apply 'widget-default-notify widget args))
909 912
910 (defun custom-redraw (widget) 913 (defun custom-redraw (widget)
971 :group 'customize) 974 :group 'customize)
972 975
973 (define-widget 'custom-variable 'custom 976 (define-widget 'custom-variable 'custom
974 "Customize variable." 977 "Customize variable."
975 :format "%l%v%m%h%a" 978 :format "%l%v%m%h%a"
976 :help-echo "Push me to set or reset this variable." 979 :help-echo "Set or reset this variable."
977 :documentation-property 'variable-documentation 980 :documentation-property 'variable-documentation
978 :custom-state nil 981 :custom-state nil
979 :custom-menu 'custom-variable-menu-create 982 :custom-menu 'custom-variable-menu-create
980 :custom-form 'edit 983 :custom-form 'edit
981 :value-create 'custom-variable-value-create 984 :value-create 'custom-variable-value-create
1203 (widget-put widget :custom-state 'unknown) 1206 (widget-put widget :custom-state 'unknown)
1204 (custom-redraw widget))) 1207 (custom-redraw widget)))
1205 1208
1206 ;;; The `custom-face-edit' Widget. 1209 ;;; The `custom-face-edit' Widget.
1207 1210
1208 (defvar custom-face-edit-args
1209 (mapcar (lambda (att)
1210 (list 'group
1211 :inline t
1212 (list 'const :format "" :value (nth 0 att))
1213 (nth 1 att)))
1214 custom-face-attributes))
1215
1216 (define-widget 'custom-face-edit 'checklist 1211 (define-widget 'custom-face-edit 'checklist
1217 "Edit face attributes." 1212 "Edit face attributes."
1218 :format "%t: %v" 1213 :format "%t: %v"
1219 :tag "Attributes" 1214 :tag "Attributes"
1220 :extra-offset 12 1215 :extra-offset 12
1216 :button-args '(:help-echo "Control whether this attribute have any effect.")
1221 :args (mapcar (lambda (att) 1217 :args (mapcar (lambda (att)
1222 (list 'group 1218 (list 'group
1223 :inline t 1219 :inline t
1220 :sibling-args (widget-get (nth 1 att) :sibling-args)
1224 (list 'const :format "" :value (nth 0 att)) 1221 (list 'const :format "" :value (nth 0 att))
1225 (nth 1 att))) 1222 (nth 1 att)))
1226 custom-face-attributes)) 1223 custom-face-attributes))
1227 1224
1228 ;;; The `custom-display' Widget. 1225 ;;; The `custom-display' Widget.
1229 1226
1230 (define-widget 'custom-display 'menu-choice 1227 (define-widget 'custom-display 'menu-choice
1231 "Select a display type." 1228 "Select a display type."
1232 :tag "Display" 1229 :tag "Display"
1233 :value t 1230 :value t
1231 :help-echo "Specify frames where the face attributes should be used."
1234 :args '((const :tag "all" t) 1232 :args '((const :tag "all" t)
1235 (checklist :offset 0 1233 (checklist
1236 :extra-offset 9 1234 :offset 0
1237 :args ((group (const :format "Type: " type) 1235 :extra-offset 9
1238 (checklist :inline t 1236 :args ((group :sibling-args (:help-echo "\
1239 :offset 0 1237 Only match the specified window systems.")
1240 (const :format "X " 1238 (const :format "Type: "
1241 x) 1239 type)
1242 (const :format "PM " 1240 (checklist :inline t
1243 pm) 1241 :offset 0
1244 (const :format "Win32 " 1242 (const :format "X "
1245 win32) 1243 :sibling-args (:help-echo "\
1246 (const :format "DOS " 1244 The X11 Window System.")
1247 pc) 1245 x)
1248 (const :format "TTY%n" 1246 (const :format "PM "
1249 tty))) 1247 :sibling-args (:help-echo "\
1250 (group (const :format "Class: " class) 1248 OS/2 Presentation Manager.")
1251 (checklist :inline t 1249 pm)
1252 :offset 0 1250 (const :format "Win32 "
1253 (const :format "Color " 1251 :sibling-args (:help-echo "\
1254 color) 1252 Windows NT/95/97.")
1255 (const :format 1253 win32)
1256 "Grayscale " 1254 (const :format "DOS "
1257 grayscale) 1255 :sibling-args (:help-echo "\
1258 (const :format "Monochrome%n" 1256 Plain MS-DOS.")
1259 mono))) 1257 pc)
1260 (group (const :format "Background: " background) 1258 (const :format "TTY%n"
1261 (checklist :inline t 1259 :sibling-args (:help-echo "\
1262 :offset 0 1260 Plain text terminals.")
1263 (const :format "Light " 1261 tty)))
1264 light) 1262 (group :sibling-args (:help-echo "\
1265 (const :format "Dark\n" 1263 Only match the frames with the specified color support.")
1266 dark))))))) 1264 (const :format "Class: "
1265 class)
1266 (checklist :inline t
1267 :offset 0
1268 (const :format "Color "
1269 :sibling-args (:help-echo "\
1270 Match color frames.")
1271 color)
1272 (const :format "Grayscale "
1273 :sibling-args (:help-echo "\
1274 Match grayscale frames.")
1275 grayscale)
1276 (const :format "Monochrome%n"
1277 :sibling-args (:help-echo "\
1278 Match frames with no color support.")
1279 mono)))
1280 (group :sibling-args (:help-echo "\
1281 Only match frames with the specified intensity.")
1282 (const :format "\
1283 Background brightness: "
1284 background)
1285 (checklist :inline t
1286 :offset 0
1287 (const :format "Light "
1288 :sibling-args (:help-echo "\
1289 Match frames with light backgrounds.")
1290 light)
1291 (const :format "Dark\n"
1292 :sibling-args (:help-echo "\
1293 Match frames with dark backgrounds.")
1294 dark)))))))
1267 1295
1268 ;;; The `custom-face' Widget. 1296 ;;; The `custom-face' Widget.
1269 1297
1270 (defface custom-face-tag-face '((t (:underline t))) 1298 (defface custom-face-tag-face '((t (:underline t)))
1271 "Face used for face tags." 1299 "Face used for face tags."
1274 (define-widget 'custom-face 'custom 1302 (define-widget 'custom-face 'custom
1275 "Customize face." 1303 "Customize face."
1276 :format "%l%{%t%}: %s%m%h%a%v" 1304 :format "%l%{%t%}: %s%m%h%a%v"
1277 :format-handler 'custom-face-format-handler 1305 :format-handler 'custom-face-format-handler
1278 :sample-face 'custom-face-tag-face 1306 :sample-face 'custom-face-tag-face
1279 :help-echo "Push me to set or reset this face." 1307 :help-echo "Set or reset this face."
1280 :documentation-property '(lambda (face) 1308 :documentation-property '(lambda (face)
1281 (face-documentation face)) 1309 (face-doc-string face))
1282 :value-create 'custom-face-value-create 1310 :value-create 'custom-face-value-create
1283 :action 'custom-face-action 1311 :action 'custom-face-action
1284 :custom-set 'custom-face-set 1312 :custom-set 'custom-face-set
1285 :custom-save 'custom-face-save 1313 :custom-save 'custom-face-save
1286 :custom-reset-current 'custom-redraw 1314 :custom-reset-current 'custom-redraw
1318 (edit (widget-create-child-and-convert 1346 (edit (widget-create-child-and-convert
1319 widget 'editable-list 1347 widget 'editable-list
1320 :entry-format "%i %d %v" 1348 :entry-format "%i %d %v"
1321 :value (or (get symbol 'saved-face) 1349 :value (or (get symbol 'saved-face)
1322 (get symbol 'factory-face)) 1350 (get symbol 'factory-face))
1351 :insert-button-args '(:help-echo "\
1352 Insert new display specification here.")
1353 :append-button-args '(:help-echo "\
1354 Append new display specification here.")
1355 :delete-button-args '(:help-echo "\
1356 Delete this display specification.")
1323 '(group :format "%v" 1357 '(group :format "%v"
1324 custom-display custom-face-edit)))) 1358 custom-display custom-face-edit))))
1325 (custom-face-state-set widget) 1359 (custom-face-state-set widget)
1326 (widget-put widget :children (list edit))))) 1360 (widget-put widget :children (list edit)))))
1327 1361
1524 (define-widget 'custom-group 'custom 1558 (define-widget 'custom-group 'custom
1525 "Customize group." 1559 "Customize group."
1526 :format "%l%{%t%}:%L\n%m%h%a%v" 1560 :format "%l%{%t%}:%L\n%m%h%a%v"
1527 :sample-face-get 'custom-group-sample-face-get 1561 :sample-face-get 'custom-group-sample-face-get
1528 :documentation-property 'group-documentation 1562 :documentation-property 'group-documentation
1529 :help-echo "Push me to set or reset all members of this group." 1563 :help-echo "Set or reset all members of this group."
1530 :value-create 'custom-group-value-create 1564 :value-create 'custom-group-value-create
1531 :action 'custom-group-action 1565 :action 'custom-group-action
1532 :custom-set 'custom-group-set 1566 :custom-set 'custom-group-set
1533 :custom-save 'custom-group-save 1567 :custom-save 'custom-group-save
1534 :custom-reset-current 'custom-group-reset-current 1568 :custom-reset-current 'custom-group-reset-current
1807 (add-hook 'custom-define-hook 'custom-menu-reset) 1841 (add-hook 'custom-define-hook 'custom-menu-reset)
1808 (let ((menu `(,(car custom-help-menu) 1842 (let ((menu `(,(car custom-help-menu)
1809 ,(widget-apply '(custom-group) :custom-menu 'emacs) 1843 ,(widget-apply '(custom-group) :custom-menu 'emacs)
1810 ,@(cdr (cdr custom-help-menu))))) 1844 ,@(cdr (cdr custom-help-menu)))))
1811 (if (fboundp 'add-submenu) 1845 (if (fboundp 'add-submenu)
1812 (add-submenu '("Help") menu) 1846 (add-submenu '("Options") menu)
1813 (define-key global-map [menu-bar help-menu customize-menu] 1847 (define-key global-map [menu-bar help-menu customize-menu]
1814 (cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu))))))) 1848 (cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu)))))))
1815 1849
1816 ;;; Dependencies. 1850 ;;; Dependencies.
1817 1851