Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 4434:7f3d065a56a1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Ease customization of faces under point... ... by providing an optional prefix argument to customize-face[-other-window].
author Didier Verna <didier@xemacs.org>
date Wed, 05 Mar 2008 10:41:54 +0100
parents 12ff8dc2b57e
children 877ad4697eea
comparison
equal deleted inserted replaced
4433:1bf48c59700e 4434:7f3d065a56a1
1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages. 1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
2 ;; 2 ;;
3 ;; Copyright (C) 2007 Didier Verna 3 ;; Copyright (C) 2007, 2008 Didier Verna
4 ;; Copyright (C) 2003 Ben Wing 4 ;; Copyright (C) 2003 Ben Wing
5 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. 5 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
6 ;; 6 ;;
7 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 7 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
8 ;; Maintainer: Didier Verna <didier@xemacs.org> 8 ;; Maintainer: Didier Verna <didier@xemacs.org>
834 (and (boundp symbol) 834 (and (boundp symbol)
835 (let ((version (get symbol 'custom-version))) 835 (let ((version (get symbol 'custom-version)))
836 (and version 836 (and version
837 (or (null since-version) 837 (or (null since-version)
838 (customize-version-lessp since-version 838 (customize-version-lessp since-version
839 version)))) 839 version))))
840 (push (list symbol 'custom-variable) found)))) 840 (push (list symbol 'custom-variable) found))))
841 (unless found 841 (unless found
842 (error "No user options have changed defaults %s" 842 (error "No user options have changed defaults %s"
843 (if since-version 843 (if since-version
844 (format "since XEmacs %s" since-version) 844 (format "since XEmacs %s" since-version)
868 (interactive (custom-variable-prompt)) 868 (interactive (custom-variable-prompt))
869 (custom-buffer-create-other-window 869 (custom-buffer-create-other-window
870 (list (list symbol 'custom-variable)) 870 (list (list symbol 'custom-variable))
871 (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol)))) 871 (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
872 872
873
874 (defun custom-face-prompt ()
875 ;; Interactive call for `customize-face' and `customize-face-other-window'.
876 ;; See their docstrings for more information. Note that this call returns a
877 ;; list of only one element. This is because the callers'second arg AT-POINT
878 ;; is only used in interactive calls.
879 (let ((faces (get-char-property (point) 'face)))
880 (if (or (null faces) (not current-prefix-arg))
881 ;; The default behavior, which is to prompt for all faces, is also
882 ;; used as a fall back when a prefix is given but there's no face
883 ;; under point:
884 (let ((choice (completing-read "Customize face: (default all) "
885 obarray 'find-face)))
886 (if (zerop (length choice))
887 nil
888 (list (intern choice))))
889 (cond ((symbolp faces)
890 ;; Customize only this one:
891 (list (list faces)))
892 ((listp faces)
893 ;; Make a choice only amongst the faces under point:
894 (let ((choice (completing-read
895 "Customize face: (default all faces at point) "
896 (mapcar (lambda (face)
897 (list (symbol-name face) face))
898 faces)
899 nil t)))
900 (if (zerop (length choice))
901 (list faces)
902 (list (intern choice)))))))))
903
904 (defun customize-face-1 (face custom-buffer-create-fn)
905 ;; Customize FACE in a buffer created with BUFFER-CREATE-FN.
906 ;; See the docstring of `customize-face' and `customize-face-other-window'
907 ;; for more information.
908 (cond ((null face)
909 (funcall custom-buffer-create-fn
910 (custom-sort-items
911 (mapcar (lambda (symbol)
912 (list symbol 'custom-face))
913 (face-list))
914 t nil)
915 "*Customize All Faces*"))
916 ((listp face)
917 (funcall custom-buffer-create-fn
918 (custom-sort-items
919 (mapcar (lambda (symbol)
920 (list symbol 'custom-face))
921 face)
922 t nil)
923 "*Customize Some Faces*"))
924 ((symbolp face)
925 (funcall custom-buffer-create-fn
926 (list (list face 'custom-face))
927 (format "*Customize Face: %s*"
928 (custom-unlispify-tag-name face))))
929 (t
930 (signal-error 'wrong-type-argument
931 '((or null listp symbolp) face)))))
932
933
873 ;;;###autoload 934 ;;;###autoload
874 (defun customize-face (&optional symbol) 935 (defun customize-face (&optional face at-point)
875 "Customize SYMBOL, which should be a face name or nil. 936 "Open a customization buffer for FACE.
876 If SYMBOL is nil, customize all faces." 937 FACE should be either:
877 (interactive (list (completing-read "Customize face: (default all) " 938 - nil, meaning to customize all faces,
878 obarray 'find-face))) 939 - a list of symbols naming faces, meaning to customize only those,
879 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) 940 - a symbol naming a face, meaning to customize this face only.
880 (custom-buffer-create (custom-sort-items 941
881 (mapcar (lambda (symbol) 942 When called interactively, use a prefix (the AT-POINT argument) to
882 (list symbol 'custom-face)) 943 make a choice among the faces found at current position."
883 (face-list)) 944 (interactive (custom-face-prompt))
884 t nil) 945 (customize-face-1 face #'custom-buffer-create))
885 "*Customize Faces*")
886 (when (stringp symbol)
887 (setq symbol (intern symbol)))
888 (check-argument-type 'symbolp symbol)
889 (custom-buffer-create (list (list symbol 'custom-face))
890 (format "*Customize Face: %s*"
891 (custom-unlispify-tag-name symbol)))))
892 946
893 ;;;###autoload 947 ;;;###autoload
894 (defun customize-face-other-window (&optional symbol) 948 (defun customize-face-other-window (&optional face at-point)
895 "Show customization buffer for FACE in other window." 949 "Like `customize-face', but use another window."
896 (interactive (list (completing-read "Customize face: " 950 (interactive (custom-face-prompt))
897 obarray 'find-face))) 951 (customize-face-1 face #'custom-buffer-create-other-window))
898 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) 952
899 ()
900 (if (stringp symbol)
901 (setq symbol (intern symbol)))
902 (check-argument-type 'symbolp symbol)
903 (custom-buffer-create-other-window
904 (list (list symbol 'custom-face))
905 (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol)))))
906 953
907 ;;;###autoload 954 ;;;###autoload
908 (defun customize-customized () 955 (defun customize-customized ()
909 "Customize all user options set since the last save in this session." 956 "Customize all user options set since the last save in this session."
910 (interactive) 957 (interactive)
2205 (widget-put widget :custom-state state))) 2252 (widget-put widget :custom-state state)))
2206 2253
2207 (defvar custom-variable-menu 2254 (defvar custom-variable-menu
2208 `(("Set for Current Session" custom-variable-set 2255 `(("Set for Current Session" custom-variable-set
2209 ,#'(lambda (widget) 2256 ,#'(lambda (widget)
2210 (eq (widget-get widget :custom-state) 'modified))) 2257 (eq (widget-get widget :custom-state) 'modified)))
2211 ("Save for Future Sessions" custom-variable-save 2258 ("Save for Future Sessions" custom-variable-save
2212 ,#'(lambda (widget) 2259 ,#'(lambda (widget)
2213 (memq (widget-get widget :custom-state) 2260 (memq (widget-get widget :custom-state)
2214 '(modified set changed rogue)))) 2261 '(modified set changed rogue))))
2215 ("Reset to Current" custom-redraw 2262 ("Reset to Current" custom-redraw
2216 ,#'(lambda (widget) 2263 ,#'(lambda (widget)
2217 (and (default-boundp (widget-value widget)) 2264 (and (default-boundp (widget-value widget))
2218 (memq (widget-get widget :custom-state) '(modified changed))))) 2265 (memq (widget-get widget :custom-state) '(modified changed)))))
2219 ("Reset to Saved" custom-variable-reset-saved 2266 ("Reset to Saved" custom-variable-reset-saved
2220 ,#'(lambda (widget) 2267 ,#'(lambda (widget)
2221 (and (or (get (widget-value widget) 'saved-value) 2268 (and (or (get (widget-value widget) 'saved-value)
2222 (get (widget-value widget) 'saved-variable-comment)) 2269 (get (widget-value widget) 'saved-variable-comment))
2223 (memq (widget-get widget :custom-state) 2270 (memq (widget-get widget :custom-state)
2224 '(modified set changed rogue))))) 2271 '(modified set changed rogue)))))
2225 ("Reset to Standard Settings" custom-variable-reset-standard 2272 ("Reset to Standard Settings" custom-variable-reset-standard
2226 ,#'(lambda (widget) 2273 ,#'(lambda (widget)
2227 (and (get (widget-value widget) 'standard-value) 2274 (and (get (widget-value widget) 'standard-value)
2228 (memq (widget-get widget :custom-state) 2275 (memq (widget-get widget :custom-state)
2229 '(modified set changed saved rogue))))) 2276 '(modified set changed saved rogue)))))
2230 ("---" ignore ignore) 2277 ("---" ignore ignore)
2231 ("Add Comment" custom-comment-show custom-comment-invisible-p) 2278 ("Add Comment" custom-comment-show custom-comment-invisible-p)
2232 ("---" ignore ignore) 2279 ("---" ignore ignore)
2233 ("Don't show as Lisp expression" custom-variable-edit 2280 ("Don't show as Lisp expression" custom-variable-edit
2234 ,#'(lambda (widget) 2281 ,#'(lambda (widget)
2235 (eq (widget-get widget :custom-form) 'lisp))) 2282 (eq (widget-get widget :custom-form) 'lisp)))
2236 ("Show as Lisp expression" custom-variable-edit-lisp 2283 ("Show as Lisp expression" custom-variable-edit-lisp
2237 ,#'(lambda (widget) 2284 ,#'(lambda (widget)
2238 (eq (widget-get widget :custom-form) 'edit)))) 2285 (eq (widget-get widget :custom-form) 'edit))))
2239 "Alist of actions for the `custom-variable' widget. 2286 "Alist of actions for the `custom-variable' widget.
2240 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 2287 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
2241 the menu entry, ACTION is the function to call on the widget when the 2288 the menu entry, ACTION is the function to call on the widget when the
2242 menu is selected, and FILTER is a predicate which takes a `custom-variable' 2289 menu is selected, and FILTER is a predicate which takes a `custom-variable'
2243 widget as an argument, and returns non-nil if ACTION is valid on that 2290 widget as an argument, and returns non-nil if ACTION is valid on that
2699 (defvar custom-face-menu 2746 (defvar custom-face-menu
2700 `(("Set for Current Session" custom-face-set) 2747 `(("Set for Current Session" custom-face-set)
2701 ("Save for Future Sessions" custom-face-save) 2748 ("Save for Future Sessions" custom-face-save)
2702 ("Reset to Saved" custom-face-reset-saved 2749 ("Reset to Saved" custom-face-reset-saved
2703 ,#'(lambda (widget) 2750 ,#'(lambda (widget)
2704 (or (get (widget-value widget) 'saved-face) 2751 (or (get (widget-value widget) 'saved-face)
2705 (get (widget-value widget) 'saved-face-comment)))) 2752 (get (widget-value widget) 'saved-face-comment))))
2706 ("Reset to Standard Setting" custom-face-reset-standard 2753 ("Reset to Standard Setting" custom-face-reset-standard
2707 ,#'(lambda (widget) 2754 ,#'(lambda (widget)
2708 (get (widget-value widget) 'face-defface-spec))) 2755 (get (widget-value widget) 'face-defface-spec)))
2709 ("---" ignore ignore) 2756 ("---" ignore ignore)
2710 ("Add Comment" custom-comment-show custom-comment-invisible-p) 2757 ("Add Comment" custom-comment-show custom-comment-invisible-p)
2711 ("---" ignore ignore) 2758 ("---" ignore ignore)
2712 ("Show all display specs" custom-face-edit-all 2759 ("Show all display specs" custom-face-edit-all
2713 ,#'(lambda (widget) 2760 ,#'(lambda (widget)
2714 (not (eq (widget-get widget :custom-form) 'all)))) 2761 (not (eq (widget-get widget :custom-form) 'all))))
2715 ("Just current attributes" custom-face-edit-selected 2762 ("Just current attributes" custom-face-edit-selected
2716 ,#'(lambda (widget) 2763 ,#'(lambda (widget)
2717 (not (eq (widget-get widget :custom-form) 'selected)))) 2764 (not (eq (widget-get widget :custom-form) 'selected))))
2718 ("Show as Lisp expression" custom-face-edit-lisp 2765 ("Show as Lisp expression" custom-face-edit-lisp
2719 ,#'(lambda (widget) 2766 ,#'(lambda (widget)
2720 (not (eq (widget-get widget :custom-form) 'lisp))))) 2767 (not (eq (widget-get widget :custom-form) 'lisp)))))
2721 "Alist of actions for the `custom-face' widget. 2768 "Alist of actions for the `custom-face' widget.
2722 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 2769 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
2723 the menu entry, ACTION is the function to call on the widget when the 2770 the menu entry, ACTION is the function to call on the widget when the
2724 menu is selected, and FILTER is a predicate which takes a `custom-face' 2771 menu is selected, and FILTER is a predicate which takes a `custom-face'
2725 widget as an argument, and returns non-nil if ACTION is valid on that 2772 widget as an argument, and returns non-nil if ACTION is valid on that
3339 (insert "/\n"))))) 3386 (insert "/\n")))))
3340 3387
3341 (defvar custom-group-menu 3388 (defvar custom-group-menu
3342 `(("Set for Current Session" custom-group-set 3389 `(("Set for Current Session" custom-group-set
3343 ,#'(lambda (widget) 3390 ,#'(lambda (widget)
3344 (eq (widget-get widget :custom-state) 'modified))) 3391 (eq (widget-get widget :custom-state) 'modified)))
3345 ("Save for Future Sessions" custom-group-save 3392 ("Save for Future Sessions" custom-group-save
3346 ,#'(lambda (widget) 3393 ,#'(lambda (widget)
3347 (memq (widget-get widget :custom-state) '(modified set)))) 3394 (memq (widget-get widget :custom-state) '(modified set))))
3348 ("Reset to Current" custom-group-reset-current 3395 ("Reset to Current" custom-group-reset-current
3349 ,#'(lambda (widget) 3396 ,#'(lambda (widget)
3350 (memq (widget-get widget :custom-state) '(modified)))) 3397 (memq (widget-get widget :custom-state) '(modified))))
3351 ("Reset to Saved" custom-group-reset-saved 3398 ("Reset to Saved" custom-group-reset-saved
3352 ,#'(lambda (widget) 3399 ,#'(lambda (widget)
3353 (memq (widget-get widget :custom-state) '(modified set)))) 3400 (memq (widget-get widget :custom-state) '(modified set))))
3354 ("Reset to standard setting" custom-group-reset-standard 3401 ("Reset to standard setting" custom-group-reset-standard
3355 ,#'(lambda (widget) 3402 ,#'(lambda (widget)
3356 (memq (widget-get widget :custom-state) '(modified set saved))))) 3403 (memq (widget-get widget :custom-state) '(modified set saved)))))
3357 "Alist of actions for the `custom-group' widget. 3404 "Alist of actions for the `custom-group' widget.
3358 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 3405 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3359 the menu entry, ACTION is the function to call on the widget when the 3406 the menu entry, ACTION is the function to call on the widget when the
3360 menu is selected, and FILTER is a predicate which takes a `custom-group' 3407 menu is selected, and FILTER is a predicate which takes a `custom-group'
3361 widget as an argument, and returns non-nil if ACTION is valid on that 3408 widget as an argument, and returns non-nil if ACTION is valid on that
3765 (let ((inhibit-read-only t)) 3812 (let ((inhibit-read-only t))
3766 (custom-save-variables) 3813 (custom-save-variables)
3767 (custom-save-faces) 3814 (custom-save-faces)
3768 (let ((find-file-hooks nil) 3815 (let ((find-file-hooks nil)
3769 (auto-mode-alist) 3816 (auto-mode-alist)
3770 custom-file-directory) 3817 custom-file-directory)
3771 (unless (file-directory-p (setq custom-file-directory 3818 (unless (file-directory-p (setq custom-file-directory
3772 (file-name-directory custom-file))) 3819 (file-name-directory custom-file)))
3773 (message "Creating %s... " custom-file-directory) 3820 (message "Creating %s... " custom-file-directory)
3774 (make-directory custom-file-directory t) 3821 (make-directory custom-file-directory t)
3775 (message "Creating %s... done." custom-file-directory)) 3822 (message "Creating %s... done." custom-file-directory))
3776 (with-current-buffer (find-file-noselect custom-file) 3823 (with-current-buffer (find-file-noselect custom-file)
3777 (save-buffer))))) 3824 (save-buffer)))))
3778 3825
3779 3826
3780 ;;; The Customize Menu. 3827 ;;; The Customize Menu.