Mercurial > hg > xemacs-beta

comparison lisp/custom/custom-edit.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 859a2309aef8
children 4103f0995bd7
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;;; custom-edit.el --- Tools for customization Emacs. 1 ;;; custom-edit.el --- Tools for customization Emacs.
2 ;; 2 ;;
3 ;; Copyright (C) 1996 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.30 7 ;; Version: 1.40
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'.
154 if that value is non-nil." 154 if that value is non-nil."
155 (kill-all-local-variables) 155 (kill-all-local-variables)
156 (setq major-mode 'custom-mode 156 (setq major-mode 'custom-mode
157 mode-name "Custom") 157 mode-name "Custom")
158 (use-local-map custom-mode-map) 158 (use-local-map custom-mode-map)
159 (easy-menu-add custom-mode-menu)
159 (make-local-variable 'custom-options) 160 (make-local-variable 'custom-options)
160 (run-hooks 'custom-mode-hook)) 161 (run-hooks 'custom-mode-hook))
161 162
162 ;;; Custom Mode Commands. 163 ;;; Custom Mode Commands.
163 164
359 :action (lambda (widget &optional event) 360 :action (lambda (widget &optional event)
360 (custom-save))) 361 (custom-save)))
361 (widget-insert " ") 362 (widget-insert " ")
362 (widget-create 'push-button 363 (widget-create 'push-button
363 :tag "Reset" 364 :tag "Reset"
364 :help-echo "Push me to undo all modifications.." 365 :help-echo "Push me to undo all modifications."
365 :action (lambda (widget &optional event) 366 :action (lambda (widget &optional event)
366 (custom-reset event))) 367 (custom-reset event)))
368 (widget-insert " ")
369 (widget-create 'push-button
370 :tag "Done"
371 :help-echo "Push me to bury the buffer."
372 :action (lambda (widget &optional event)
373 (bury-buffer)))
367 (widget-insert "\n") 374 (widget-insert "\n")
368 (widget-setup)) 375 (widget-setup))
369 376
370 ;;; Modification of Basic Widgets. 377 ;;; Modification of Basic Widgets.
371 ;; 378 ;;
698 (custom-magic-reset widget)) 705 (custom-magic-reset widget))
699 (apply 'widget-default-notify widget args)) 706 (apply 'widget-default-notify widget args))
700 707
701 (defun custom-redraw (widget) 708 (defun custom-redraw (widget)
702 "Redraw WIDGET with current settings." 709 "Redraw WIDGET with current settings."
703 (widget-value-set widget (widget-value widget)) 710 (let ((pos (point))
704 (custom-redraw-magic widget)) 711 (from (marker-position (widget-get widget :from)))
712 (to (marker-position (widget-get widget :to))))
713 (save-excursion
714 (widget-value-set widget (widget-value widget))
715 (custom-redraw-magic widget))
716 (when (and (>= pos from) (<= pos to))
717 (goto-char pos))))
705 718
706 (defun custom-redraw-magic (widget) 719 (defun custom-redraw-magic (widget)
707 "Redraw WIDGET state with current settings." 720 "Redraw WIDGET state with current settings."
708 (while widget 721 (while widget
709 (let ((magic (widget-get widget :custom-magic))) 722 (let ((magic (widget-get widget :custom-magic)))
858 tmp 871 tmp
859 (state (cond ((setq tmp (get symbol 'customized-value)) 872 (state (cond ((setq tmp (get symbol 'customized-value))
860 (if (condition-case nil 873 (if (condition-case nil
861 (equal value (eval (car tmp))) 874 (equal value (eval (car tmp)))
862 (error nil)) 875 (error nil))
863 'saved 876 'set
864 'set)) 877 'changed))
865 ((setq tmp (get symbol 'saved-value)) 878 ((setq tmp (get symbol 'saved-value))
866 (if (condition-case nil 879 (if (condition-case nil
867 (equal value (eval (car tmp))) 880 (equal value (eval (car tmp)))
868 (error nil)) 881 (error nil))
869 'saved 882 'saved
870 'set)) 883 'changed))
871 ((setq tmp (get symbol 'factory-value)) 884 ((setq tmp (get symbol 'factory-value))
872 (if (condition-case nil 885 (if (condition-case nil
873 (equal value (eval (car tmp))) 886 (equal value (eval (car tmp)))
874 (error nil)) 887 (error nil))
875 'factory 888 'factory
876 'set)) 889 'changed))
877 (t 'rogue)))) 890 (t 'rogue))))
878 (widget-put widget :custom-state state))) 891 (widget-put widget :custom-state state)))
879 892
880 (defvar custom-variable-menu 893 (defvar custom-variable-menu
881 '(("Edit" . custom-variable-edit) 894 '(("Edit" . custom-variable-edit)
896 (if (eq (widget-get widget :custom-state) 'hidden) 909 (if (eq (widget-get widget :custom-state) 'hidden)
897 (progn 910 (progn
898 (widget-put widget :custom-state 'unknown) 911 (widget-put widget :custom-state 'unknown)
899 (custom-redraw widget)) 912 (custom-redraw widget))
900 (let* ((completion-ignore-case t) 913 (let* ((completion-ignore-case t)
901 (answer (widget-choose (symbol-name (widget-get widget :value)) 914 (answer (widget-choose (capitalize
915 (symbol-name (widget-get widget :value)))
902 custom-variable-menu 916 custom-variable-menu
903 event))) 917 event)))
904 (if answer 918 (if answer
905 (funcall answer widget))))) 919 (funcall answer widget)))))
906 920
930 (error "%s" (widget-get val :error))) 944 (error "%s" (widget-get val :error)))
931 ((eq form 'lisp) 945 ((eq form 'lisp)
932 (set symbol (eval (setq val (widget-value child)))) 946 (set symbol (eval (setq val (widget-value child))))
933 (put symbol 'customized-value (list val))) 947 (put symbol 'customized-value (list val)))
934 (t 948 (t
935 (set symbol (widget-value child)) 949 (set symbol (setq val (widget-value child)))
936 (put symbol 'customized-value (list (custom-quote val))))) 950 (put symbol 'customized-value (list (custom-quote val)))))
937 (custom-variable-state-set widget) 951 (custom-variable-state-set widget)
938 (custom-redraw-magic widget))) 952 (custom-redraw-magic widget)))
939 953
940 (defun custom-variable-save (widget) 954 (defun custom-variable-save (widget)
1137 (progn 1151 (progn
1138 (widget-put widget :custom-state 'unknown) 1152 (widget-put widget :custom-state 'unknown)
1139 (custom-redraw widget)) 1153 (custom-redraw widget))
1140 (let* ((completion-ignore-case t) 1154 (let* ((completion-ignore-case t)
1141 (symbol (widget-get widget :value)) 1155 (symbol (widget-get widget :value))
1142 (answer (widget-choose (symbol-name symbol) 1156 (answer (widget-choose (capitalize (symbol-name symbol))
1143 custom-face-menu event))) 1157 custom-face-menu event)))
1144 (if answer 1158 (if answer
1145 (funcall answer widget))))) 1159 (funcall answer widget)))))
1146 1160
1147 (defun custom-face-set (widget) 1161 (defun custom-face-set (widget)
1360 (if (eq (widget-get widget :custom-state) 'hidden) 1374 (if (eq (widget-get widget :custom-state) 'hidden)
1361 (progn 1375 (progn
1362 (widget-put widget :custom-state 'unknown) 1376 (widget-put widget :custom-state 'unknown)
1363 (custom-redraw widget)) 1377 (custom-redraw widget))
1364 (let* ((completion-ignore-case t) 1378 (let* ((completion-ignore-case t)
1365 (answer (widget-choose (symbol-name (widget-get widget :value)) 1379 (answer (widget-choose (capitalize
1380 (symbol-name (widget-get widget :value)))
1366 custom-group-menu 1381 custom-group-menu
1367 event))) 1382 event)))
1368 (if answer 1383 (if answer
1369 (funcall answer widget))))) 1384 (funcall answer widget)))))
1370 1385