Mercurial > hg > xemacs-beta
diff lisp/custom/cus-edit.el @ 173:8eaf7971accc r20-3b13
Import from CVS: tag r20-3b13
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:49:09 +0200 |
parents | 929b76928fce |
children | 9ad43877534d |
line wrap: on
line diff
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:47:55 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:49:09 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9940 +;; Version: 1.9951 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -768,6 +768,26 @@ (put var 'customized-value (list (custom-quote val)))) ;;;###autoload +(defun customize-save-variable (var val) + "Set the default for VARIABLE to VALUE, and save it for future sessions. +If VARIABLE has a `custom-set' property, that is used for setting +VARIABLE, otherwise `set-default' is used. + +The `customized-value' property of the VARIABLE will be set to a list +with a quoted VALUE as its sole list member. + +If VARIABLE has a `variable-interactive' property, that is used as if +it were the arg to `interactive' (which see) to interactively read the value. + +If VARIABLE has a `custom-type' property, it must be a widget and the +`:prompt-value' property of that widget will be used for reading the value. " + (interactive (custom-prompt-variable "Set and ave variable: " + "Set and save value for %s as: ")) + (funcall (or (get var 'custom-set) 'set-default) var val) + (put var 'saved-value (list (custom-quote val))) + (custom-save-all)) + +;;;###autoload (defun customize () "Select a customization buffer which you can use to set user options. User options are structured into \"groups\". @@ -795,7 +815,9 @@ (if (get-buffer name) (switch-to-buffer name) (custom-buffer-create (list (list group 'custom-group)) - name)))) + name + (concat " for group " + (custom-unlispify-tag-name group)))))) ;;;###autoload (defun customize-group-other-window (symbol) @@ -879,12 +901,7 @@ (interactive) (let ((found nil)) (mapatoms (lambda (symbol) - (and (condition-case nil - (get symbol 'customized-face) - (t (progn - (message "Bad plist in %s" - (symbol-name symbol)) - nil))) + (and (get symbol 'customized-face) (custom-facep symbol) (push (list symbol 'custom-face) found)) (and (get symbol 'customized-value) @@ -901,12 +918,7 @@ (interactive) (let ((found nil)) (mapatoms (lambda (symbol) - (and (condition-case nil - (get symbol 'saved-face) - (t (progn - (message "Bad plist in %s" - (symbol-name symbol)) - nil))) + (and (get symbol 'saved-face) (custom-facep symbol) (push (list symbol 'custom-face) found)) (and (get symbol 'saved-value) @@ -986,7 +998,7 @@ :group 'custom-buffer) ;;;###autoload -(defun custom-buffer-create (options &optional name) +(defun custom-buffer-create (options &optional name description) "Create a buffer containing OPTIONS. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where @@ -995,10 +1007,10 @@ (unless name (setq name "*Customization*")) (kill-buffer (get-buffer-create name)) (switch-to-buffer (get-buffer-create name)) - (custom-buffer-create-internal options)) + (custom-buffer-create-internal options description)) ;;;###autoload -(defun custom-buffer-create-other-window (options &optional name) +(defun custom-buffer-create-other-window (options &optional name description) "Create a buffer containing OPTIONS. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where @@ -1008,7 +1020,7 @@ (kill-buffer (get-buffer-create name)) (let ((window (selected-window))) (switch-to-buffer-other-window (get-buffer-create name)) - (custom-buffer-create-internal options) + (custom-buffer-create-internal options description) (select-window window))) (defcustom custom-reset-button-menu nil @@ -1017,12 +1029,18 @@ :type 'boolean :group 'custom-buffer) -(defun custom-buffer-create-internal (options) +(defun custom-buffer-create-internal (options &optional description) (message "Creating customization buffer...") (custom-mode) - (widget-insert "This is a customization buffer. + (widget-insert "This is a customization buffer") + (if description + (widget-insert description)) + (widget-insert ". Square brackets show active fields; type RET or click mouse-2 -on an active field to invoke its action. Invoke ") +on an active field to invoke its action. Editing an option value +changes the text in the buffer; invoke the State button and +choose the Set operation to set the option value. +Invoke ") (widget-create 'info-link :tag "Help" :help-echo "Read the online help." @@ -1031,26 +1049,28 @@ (message "Creating customization buttons...") (widget-insert "Operate on everything in this buffer:\n ") (widget-create 'push-button - :tag "Set" + :tag "Set for Current Session" :help-echo "\ Make your editing in this buffer take effect for this session." :action (lambda (widget &optional event) (Custom-set))) (widget-insert " ") (widget-create 'push-button - :tag "Save" + :tag "Save for Future Sessions" :help-echo "\ Make your editing in this buffer take effect for future Emacs sessions." :action (lambda (widget &optional event) (Custom-save))) - (widget-insert " ") (if custom-reset-button-menu - (widget-create 'push-button - :tag "Reset" - :help-echo "Show a menu with reset operations." - :mouse-down-action (lambda (&rest junk) t) - :action (lambda (widget &optional event) - (custom-reset event))) + (progn + (widget-insert " ") + (widget-create 'push-button + :tag "Reset" + :help-echo "Show a menu with reset operations." + :mouse-down-action (lambda (&rest junk) t) + :action (lambda (widget &optional event) + (custom-reset event)))) + (widget-insert "\n ") (widget-create 'push-button :tag "Reset" :help-echo "\ @@ -1103,6 +1123,7 @@ options)))) (unless (eq (preceding-char) ?\n) (widget-insert "\n")) + (message "Creating customization items %2d%%...done" 100) (unless (eq custom-buffer-style 'tree) (mapcar 'custom-magic-reset custom-options)) (message "Creating customization setup...") @@ -1131,9 +1152,27 @@ (switch-to-buffer (get-buffer-create name))) (custom-mode) (widget-insert "\ -Invoke [+] or [?] below to expand items, and [-] to collapse items. -Invoke the [Group], [Face], and [Option] buttons below to edit that -item in another window.\n\n") +Invoke [+] or [?] below to expand items, and [-] to collapse items.\n") + (if custom-browse-only-groups + (widget-insert "\ +Invoke the [Group] button below to edit that item in another window.\n\n") + (widget-insert "Invoke the ") + (widget-create 'item + :format "%t" + :tag "[Group]" + :tag-glyph "folder") + (widget-insert ", ") + (widget-create 'item + :format "%t" + :tag "[Face]" + :tag-glyph "face") + (widget-insert ", and ") + (widget-create 'item + :format "%t" + :tag "[Option]" + :tag-glyph "option") + (widget-insert " buttons below to edit that +item in another window.\n\n")) (let ((custom-buffer-style 'tree)) (widget-create 'custom-group :custom-last t @@ -1284,11 +1323,11 @@ (invalid "x" custom-invalid-face "\ the value displayed for this %c is invalid and cannot be set.") (modified "*" custom-modified-face "\ -you have edited the value, and can now set the %c." "\ -you have edited something in this group, and can now set it.") +you have edited the value as text, but you have not set the %c." "\ +you have edited something in this group, but not set it.") (set "+" custom-set-face "\ -you have set this %c, but not saved it." "\ -something in this group has been set, but not yet saved.") +you have set this %c, but not saved it for future sessions." "\ +something in this group has been set, but not saved.") (changed ":" custom-changed-face "\ this %c has been changed outside the customize buffer." "\ something in this group has been changed outside customize.") @@ -1485,7 +1524,6 @@ :value-delete 'widget-children-value-delete :value-get 'widget-value-value-get :validate 'widget-children-validate - :button-face 'custom-button-face :match (lambda (widget value) (symbolp value))) (defun custom-convert-widget (widget) @@ -1659,13 +1697,7 @@ found) (insert (or initial-string "Parent groups:")) (mapatoms (lambda (symbol) - (let ((entry (assq name - (condition-case nil - (get symbol 'custom-group) - (t (progn - (message "Bad plist in %s" - (symbol-name symbol)) - nil)))))) + (let ((entry (assq name (get symbol 'custom-group)))) (when (eq (nth 1 entry) type) (insert " ") (push (widget-create-child-and-convert @@ -1900,10 +1932,10 @@ (widget-put widget :custom-state state))) (defvar custom-variable-menu - '(("Set" custom-variable-set + '(("Set for Current Session" custom-variable-set (lambda (widget) (eq (widget-get widget :custom-state) 'modified))) - ("Save" custom-variable-save + ("Save for Future Sessions" custom-variable-save (lambda (widget) (memq (widget-get widget :custom-state) '(modified set changed rogue)))) ("Reset to Current" custom-redraw @@ -2273,8 +2305,8 @@ (message "Creating face editor...done")))))) (defvar custom-face-menu - '(("Set" custom-face-set) - ("Save" custom-face-save) + '(("Set for Current Session" custom-face-set) + ("Save for Future Sessions" custom-face-save) ("Reset to Saved" custom-face-reset-saved (lambda (widget) (get (widget-value widget) 'saved-face))) @@ -2538,19 +2570,32 @@ (insert "--------"))) (widget-default-create widget)) +(defun custom-group-members (symbol groups-only) + "Return SYMBOL's custom group members. +If GROUPS-ONLY non-nil, return only those members that are groups." + (if (not groups-only) + (get symbol 'custom-group) + (let (members) + (dolist (entry (get symbol 'custom-group)) + (when (eq (nth 1 entry) 'custom-group) + (push entry members))) + (nreverse members)))) + (defun custom-group-value-create (widget) "Insert a customize group for WIDGET in the current buffer." - (let ((state (widget-get widget :custom-state)) - (level (widget-get widget :custom-level)) - (indent (widget-get widget :indent)) - (prefix (widget-get widget :custom-prefix)) - (buttons (widget-get widget :buttons)) - (tag (widget-get widget :tag)) - (symbol (widget-value widget))) + (let* ((state (widget-get widget :custom-state)) + (level (widget-get widget :custom-level)) + (indent (widget-get widget :indent)) + (prefix (widget-get widget :custom-prefix)) + (buttons (widget-get widget :buttons)) + (tag (widget-get widget :tag)) + (symbol (widget-value widget)) + (members (custom-group-members symbol + (and (eq custom-buffer-style 'tree) + custom-browse-only-groups)))) (cond ((and (eq custom-buffer-style 'tree) (eq state 'hidden) - (or (get symbol 'custom-group) - (custom-unloaded-widget-p widget))) + (or members (custom-unloaded-widget-p widget))) (custom-browse-insert-prefix prefix) (push (widget-create-child-and-convert widget 'custom-browse-visibility @@ -2565,7 +2610,7 @@ (insert " " tag "\n") (widget-put widget :buttons buttons)) ((and (eq custom-buffer-style 'tree) - (zerop (length (get symbol 'custom-group)))) + (zerop (length members))) (custom-browse-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") @@ -2578,7 +2623,7 @@ ((eq custom-buffer-style 'tree) (custom-browse-insert-prefix prefix) (custom-load-widget widget) - (if (zerop (length (get symbol 'custom-group))) + (if (zerop (length members)) (progn (custom-browse-insert-prefix prefix) (insert "[ ]-- ") @@ -2602,7 +2647,7 @@ (insert " " tag "\n") (widget-put widget :buttons buttons) (message "Creating group...") - (let* ((members (custom-sort-items (get symbol 'custom-group) + (let* ((members (custom-sort-items members custom-browse-sort-alphabetically custom-browse-order-groups)) (prefixes (widget-get widget :custom-prefixes)) @@ -2615,18 +2660,16 @@ (while members (setq entry (car members) members (cdr members)) - (when (or (not custom-browse-only-groups) - (eq (nth 1 entry) 'custom-group)) - (push (widget-create-child-and-convert - widget (nth 1 entry) - :group widget - :tag (custom-unlispify-tag-name (nth 0 entry)) - :custom-prefixes custom-prefix-list - :custom-level (1+ level) - :custom-last (null members) - :value (nth 0 entry) - :custom-prefix prefix) - children))) + (push (widget-create-child-and-convert + widget (nth 1 entry) + :group widget + :tag (custom-unlispify-tag-name (nth 0 entry)) + :custom-prefixes custom-prefix-list + :custom-level (1+ level) + :custom-last (null members) + :value (nth 0 entry) + :custom-prefix prefix) + children)) (widget-put widget :children (reverse children))) (message "Creating group...done"))) ;; Nested style. @@ -2721,7 +2764,7 @@ ;; Members. (message "Creating group...") (custom-load-widget widget) - (let* ((members (custom-sort-items (get symbol 'custom-group) + (let* ((members (custom-sort-items members custom-buffer-sort-alphabetically custom-buffer-order-groups)) (prefixes (widget-get widget :custom-prefixes)) @@ -2760,10 +2803,10 @@ (insert "/\n"))))) (defvar custom-group-menu - '(("Set" custom-group-set + '(("Set for Current Session" custom-group-set (lambda (widget) (eq (widget-get widget :custom-state) 'modified))) - ("Save" custom-group-save + ("Save for Future Sessions" custom-group-save (lambda (widget) (memq (widget-get widget :custom-state) '(modified set)))) ("Reset to Current" custom-group-reset-current @@ -2860,7 +2903,10 @@ ;;; The `custom-save-all' Function. ;;;###autoload (defcustom custom-file (if (boundp 'emacs-user-extension-dir) - (concat emacs-user-extension-dir "options.el") + (concat "~" + init-file-user + emacs-user-extension-dir + "options.el") "~/.emacs") "File used for storing customization information. If you change this from the default \"~/.emacs\" you need to @@ -2895,12 +2941,7 @@ (princ "\n")) (princ "(custom-set-variables") (mapatoms (lambda (symbol) - (let ((value (condition-case nil - (get symbol 'saved-value) - (t (progn - (message "Bad plist in %s" - (symbol-name symbol)) - nil)))) + (let ((value (get symbol 'saved-value)) (requests (get symbol 'custom-requests)) (now (not (or (get symbol 'standard-value) (and (not (boundp symbol)) @@ -2943,12 +2984,7 @@ (princ ")") (princ " t)")))) (mapatoms (lambda (symbol) - (let ((value (condition-case nil - (get symbol 'saved-face) - (t (progn - (message "Bad plist in %s" - (symbol-name symbol))) - nil)))) + (let ((value (get symbol 'saved-face))) (when (and (not (eq symbol 'default)) ;; Don't print default face here. value) @@ -2970,28 +3006,26 @@ "Save all user options which have been set in this session." (interactive) (mapatoms (lambda (symbol) - (condition-case nil - (let ((face (get symbol 'customized-face)) - (value (get symbol 'customized-value))) - (when face - (put symbol 'saved-face face) - (put symbol 'customized-face nil)) - (when value - (put symbol 'saved-value value) - (put symbol 'customized-value nil))) - (t (message "Bad plist in %s" - (symbol-name symbol)))))) + (let ((face (get symbol 'customized-face)) + (value (get symbol 'customized-value))) + (when face + (put symbol 'saved-face face) + (put symbol 'customized-face nil)) + (when value + (put symbol 'saved-value value) + (put symbol 'customized-value nil))))) ;; We really should update all custom buffers here. (custom-save-all)) ;;;###autoload (defun custom-save-all () "Save all customizations in `custom-file'." - (custom-save-variables) - (custom-save-faces) - (save-excursion - (set-buffer (find-file-noselect custom-file)) - (save-buffer))) + (let ((inhibit-read-only t)) + (custom-save-variables) + (custom-save-faces) + (save-excursion + (set-buffer (find-file-noselect custom-file)) + (save-buffer)))) ;;; The Customize Menu. @@ -3134,7 +3168,19 @@ (define-key custom-mode-map " " 'scroll-up) (define-key custom-mode-map "\177" 'scroll-down) (define-key custom-mode-map "q" 'bury-buffer) - (define-key custom-mode-map "u" 'Custom-goto-parent)) + (define-key custom-mode-map "u" 'Custom-goto-parent) + ;; (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke) + ) + +(defun Custom-move-and-invoke (event) + "Move to where you click, and if it is an active field, invoke it." + (interactive "e") + (mouse-set-point event) + (if (widget-event-point event) + (let* ((pos (widget-event-point event)) + (button (get-char-property pos 'button))) + (if button + (widget-button-click event))))) (easy-menu-define Custom-mode-menu custom-mode-map @@ -3175,7 +3221,10 @@ Move to next button or editable field. \\[widget-forward] Move to previous button or editable field. \\[widget-backward] -Invoke button under the mouse pointer. \\[widget-button-click] +\\<widget-field-keymap>\ +Complete content of editable text field. \\[widget-complete] +\\<custom-mode-map>\ +Invoke button under the mouse pointer. \\[Custom-move-and-invoke] Invoke button under point. \\[widget-button-press] Set all modifications. \\[Custom-set] Make all modifications default. \\[Custom-save] @@ -3193,6 +3242,8 @@ (make-local-variable 'custom-options) (make-local-variable 'widget-documentation-face) (setq widget-documentation-face 'custom-documentation-face) + (make-local-variable 'widget-button-face) + (setq widget-button-face 'custom-button-face) (make-local-hook 'widget-edit-functions) (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) (run-hooks 'custom-mode-hook))