Mercurial > hg > xemacs-beta
diff lisp/cus-edit.el @ 219:262b8bb4a523 r20-4b8
Import from CVS: tag r20-4b8
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:09:35 +0200 |
parents | 1f0dabaa0855 |
children | 2c611d1463a6 |
line wrap: on
line diff
--- a/lisp/cus-edit.el Mon Aug 13 10:08:36 2007 +0200 +++ b/lisp/cus-edit.el Mon Aug 13 10:09:35 2007 +0200 @@ -183,10 +183,6 @@ "Front-ends/assistants for, or emulators of, UNIX features." :group 'environment) -(defgroup vms nil - "Support code for vms." - :group 'environment) - (defgroup i18n nil "Internationalization and alternate character-set support." :group 'environment @@ -334,7 +330,7 @@ :group 'processes) (defgroup mule nil - "MULE Emacs internationalization." + "Mule XEmacs internationalization." :group 'i18n) (defgroup windows nil @@ -351,7 +347,9 @@ (eq (car-safe sexp) 'lambda) (stringp sexp) (numberp sexp) - (characterp sexp)) + (characterp sexp) + (vectorp sexp) + (bit-vector-p sexp)) sexp (list 'quote sexp))) @@ -424,7 +422,9 @@ :type 'boolean) (defcustom custom-unlispify-remove-prefixes t - "Non-nil means remove group prefixes from option names in buffers and menus." + "Non-nil means remove group prefixes from option names in buffers and menus. +This only has an effect when `custom-unlispify-tag-names' or +`custom-unlispify-menu-entries' is on." :group 'custom-menu :type 'boolean) @@ -966,7 +966,7 @@ ;;; Buffer. (defcustom custom-buffer-style 'links - "Control the presentation style for customization buffers. + "*Control the presentation style for customization buffers. The value should be a symbol, one of: brackets: groups nest within each other with big horizontal brackets. @@ -975,6 +975,15 @@ (const :tag "links: Group have links to subgroups" links)) :group 'custom-buffer) +(defcustom custom-buffer-done-function 'kill-buffer + "*Function to be used to remove the buffer when the user is done with it. +Choices include `kill-buffer' (the default) and `bury-buffer'. +The function will be called with one argument, the buffer to remove." + :type '(radio (function-item kill-buffer) + (function-item bury-buffer) + (function :tag "Other" nil)) + :group 'custom-buffer) + (defcustom custom-buffer-indent 3 "Number of spaces to indent nested groups." :type 'integer @@ -1014,6 +1023,13 @@ (defconst custom-skip-messages 5) +(defun Custom-buffer-done () + "Remove current buffer. +This works by calling the function specified by + `custom-buffer-done-function'." + (interactive) + (funcall custom-buffer-done-function (current-buffer))) + (defun custom-buffer-create-internal (options &optional description) (message "Creating customization buffer...") (custom-mode) @@ -1077,9 +1093,9 @@ (widget-create 'push-button :tag "Done" :tag-glyph '("done-up" "done-down") - :help-echo "Bury the buffer" + :help-echo "Remove the buffer" :action (lambda (widget &optional event) - (bury-buffer))) + (Custom-buffer-done))) (widget-insert "\n\n") (message "Creating customization items...") (setq custom-options @@ -1240,7 +1256,8 @@ (widget-put (get 'item 'widget-type) :custom-show t) (widget-put (get 'editable-field 'widget-type) :custom-show (lambda (widget value) - (let ((pp (pp-to-string value))) + ;; This used to call pp-to-string + (let ((pp (widget-prettyprint-to-string value))) (cond ((string-match "\n" pp) nil) ((> (length pp) 40) @@ -1723,6 +1740,12 @@ "Face used for pushable variable tags." :group 'custom-faces) +(defcustom custom-variable-default-form 'edit + "Default form of displaying variable values." + :type '(choice (const edit) + (const lisp)) + :group 'custom-buffer) + (define-widget 'custom-variable 'custom "Customize variable." :format "%v" @@ -1731,7 +1754,7 @@ :custom-category 'option :custom-state nil :custom-menu 'custom-variable-menu-create - :custom-form 'edit + :custom-form nil ; defaults to value of `custom-variable-default-form' :value-create 'custom-variable-value-create :action 'custom-variable-action :custom-set 'custom-variable-set @@ -1759,6 +1782,8 @@ (defun custom-variable-value-create (widget) "Here is where you edit the variables value." (custom-load-widget widget) + (unless (widget-get widget :custom-form) + (widget-put widget :custom-form custom-variable-default-form)) (let* ((buttons (widget-get widget :buttons)) (children (widget-get widget :children)) (form (widget-get widget :custom-form)) @@ -2160,6 +2185,13 @@ "Face used for face tags." :group 'custom-faces) +(defcustom custom-face-default-form 'selected + "Default form of displaying face definition." + :type '(choice (const all) + (const selected) + (const lisp)) + :group 'custom-buffer) + (define-widget 'custom-face 'custom "Customize face." :sample-face 'custom-face-tag-face @@ -2169,7 +2201,7 @@ :value-create 'custom-face-value-create :action 'custom-face-action :custom-category 'face - :custom-form 'selected + :custom-form nil ; defaults to value of `custom-face-default-form' :custom-set 'custom-face-set :custom-save 'custom-face-save :custom-reset-current 'custom-redraw @@ -2272,6 +2304,8 @@ (unless (eq state 'hidden) (message "Creating face editor...") (custom-load-widget widget) + (unless (widget-get widget :custom-form) + (widget-put widget :custom-form custom-face-default-form)) (let* ((symbol (widget-value widget)) (spec (or (get symbol 'saved-face) (get symbol 'face-defface-spec) @@ -2502,6 +2536,41 @@ (widget-put widget :args args) widget)) +;;; The `plist' Widget. + +(define-widget 'plist 'list + "A property list." + :match (lambda (widget value) + (valid-plist-p value)) + :convert-widget 'custom-plist-convert-widget + :tag "Property List") + +;; #### Should handle options better. +(defun custom-plist-convert-widget (widget) + (let* ((options (widget-get widget :options)) + (other `(editable-list :inline t + (group :inline t + (symbol :format "%t: %v " + :size 10 + :tag "Property") + (sexp :tag "Value")))) + (args + (if options + `((checklist :inline t + ,@(mapcar 'custom-plist-process-option options)) + ,other) + (list other)))) + (widget-put widget :args args) + widget)) + +(defun custom-plist-process-option (entry) + `(group :inline t + (const :tag "Property" + :format "%t: %v " + :size 10 + ,entry) + (sexp :tag "Value"))) + ;;; The `custom-group-link' Widget. (define-widget 'custom-group-link 'link @@ -3143,23 +3212,11 @@ (set-keymap-parents custom-mode-map widget-keymap) (suppress-keymap custom-mode-map) (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 [delete] 'scroll-down) + (define-key custom-mode-map "q" 'Custom-buffer-done) (define-key custom-mode-map "u" 'Custom-goto-parent) (define-key custom-mode-map "n" 'widget-forward) - (define-key custom-mode-map "p" 'widget-backward) - ;; (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))))) + (define-key custom-mode-map "p" 'widget-backward)) (easy-menu-define Custom-mode-menu custom-mode-map @@ -3204,7 +3261,6 @@ \\<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]