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]