xemacs-beta: lisp/cus-edit.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:c9f226976f56
+:262b8bb4a523
 (defgroup unix nil
 "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
 :group 'editing)
 (defgroup processes-basics nil
 "Basic stuff dealing with processes."
 :group 'processes)
 (defgroup mule nil
-"MULE Emacs internationalization."
+"Mule XEmacs internationalization."
 :group 'i18n)
 (defgroup windows nil
 "Windows within a frame."
 :group 'environment)
 (if (or (memq sexp '(t nil))
 	  (keywordp sexp)
 	  (eq (car-safe sexp) 'lambda)
 	  (stringp sexp)
 	  (numberp sexp)
-	  (characterp sexp))
+	  (characterp sexp)
+	  (vectorp sexp)
+	  (bit-vector-p sexp))
 sexp
 (list 'quote sexp)))
 (defun custom-split-regexp-maybe (regexp)
 "If REGEXP is a string, split it to a list at `\\|'.
 "Display menu entries as words instead of symbols if non nil."
 :group 'custom-menu
 :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)
 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
 "Convert symbol into a menu entry."
 ;;; 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.
 links: groups have links to subgroups."
 :type '(radio (const :tag "brackets: Groups nest within each others" brackets)
 		(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
 This button will have a menu with all three reset operations."
 :type 'boolean
 :group 'custom-buffer)
 (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)
 (widget-insert "This is a customization buffer")
 		   :action 'Custom-reset-standard))
 (widget-insert "  ")
 (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
 	(if (= (length options) 1)
 	    (mapcar (lambda (entry)
 ;; widgets to be hidden.
 (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)
 				    nil)
 				   (t t)))))
 (defface custom-variable-button-face '((t (:underline t :bold t)))
 "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"
 :help-echo "Set or reset this variable"
 :documentation-property 'variable-documentation
 :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
 :custom-save 'custom-variable-save
 :custom-reset-current 'custom-redraw
 tmp))
 (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))
 	 (state (widget-get widget :custom-state))
 	 (symbol (widget-get widget :value))
 (defface custom-face-tag-face '((t (:underline t)))
 "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
 :help-echo "Set or reset this face"
 :documentation-property '(lambda (face)
 			     (face-doc-string face))
 :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
 :custom-reset-saved 'custom-face-reset-saved
 :custom-reset-standard 'custom-face-reset-standard
 	   (unless (eq (preceding-char) ?\n)
 	     (insert "\n"))
 	   (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)
 			      ;; Attempt to construct it.
 			      (list (list t (face-custom-attributes-get
 					       options))
 			 other)
 		 (list other))))
 (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
 "Show parent in other window when activated."
 (unless custom-mode-map
 (setq custom-mode-map (make-sparse-keymap))
 (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 [delete] 'scroll-down)
-(define-key custom-mode-map "q" 'bury-buffer)
+(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 "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)))))
 (easy-menu-define Custom-mode-menu
 custom-mode-map
 "Menu used in customization buffers."
 `("Custom"
 Move to next button or editable field.     \\[widget-forward]
 Move to previous button or editable field. \\[widget-backward]
 \\<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]
 Reset all modified options. 		   \\[Custom-reset-current]
 Reset all modified or set options.	   \\[Custom-reset-saved]

Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 219:262b8bb4a523 r20-4b8