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

comparison lisp/custom/cus-edit.el @ 155:43dd3413c7c7 r20-3b4

Import from CVS: tag r20-3b4

author	cvs
date	Mon, 13 Aug 2007 09:39:39 +0200
parents	25f70ba0133c
children	6b37e6ddd302

comparison

equal deleted inserted replaced

-:94141801dd7e
+:43dd3413c7c7
 ;;
 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.98
+;; Version: 1.9907
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 (condition-case nil
 (require 'cus-load)
 (error nil))
-(define-widget-keywords :custom-prefixes :custom-menu :custom-show
+(condition-case nil
+(require 'cus-start)
+(error nil))
+(define-widget-keywords :custom-category :custom-prefixes :custom-menu
+:custom-show
 :custom-magic :custom-state :custom-level :custom-form
 :custom-set :custom-save :custom-reset-current :custom-reset-saved
 :custom-reset-standard)
 (put 'custom-define-hook 'custom-type 'hook)
 (defgroup menu nil
 "Input from the menus."
 :group 'environment)
 (defgroup auto-save nil
-"Preventing accidental loss of data."
+"Preventing accidential loss of data."
 :group 'data)
 (defgroup processes-basics nil
 "Basic stuff dealing with processes."
 :group 'processes)
 (defgroup mule nil
 "MULE Emacs internationalization."
-:group 'emacs)
+:group 'i18n)
 (defgroup windows nil
 "Windows within a frame."
 :group 'environment)
 Return a list suitable for use in `interactive'."
 (let ((v (variable-at-point))
 	 (enable-recursive-minibuffers t)
 	 val)
 (setq val (completing-read
-		(if v
+		(if (symbolp v)
 		    (format "Customize variable: (default %s) " v)
 		  "Customize variable: ")
 		obarray (lambda (symbol)
 			  (and (boundp symbol)
 			       (or (get symbol 'custom-type)
 				   (user-variable-p symbol))))))
 (list (if (equal val "")
-	       v (intern val)))))
+	       (if (symbolp v) v nil)
+	     (intern val)))))
 (defun custom-menu-filter (menu widget)
 "Convert MENU to the form used by `widget-choose'.
 MENU should be in the same format as `custom-variable-menu'.
 WIDGET is the widget to apply the filter entries of MENU on."
 	    (when (string-match (nth 0 current) doc)
 	      (setq found (nth 1 current)
 		    docs nil))))))
 found))
+;;; Sorting.
+(defcustom custom-buffer-sort-predicate 'custom-buffer-sort-alphabetically
+"Function used for sorting group members in buffers.
+The value should be useful as a predicate for `sort'.
+The list to be sorted is the value of the groups `custom-group' property."
+:type '(radio (function-item custom-buffer-sort-alphabetically)
+		(function :tag "Other"))
+:group 'customize)
+(defun custom-buffer-sort-alphabetically (a b)
+"Return t iff is A should be before B.
+A and B should be members of a `custom-group' property.
+The members are sorted alphabetically, except that all groups are
+sorted after all non-groups."
+(cond ((and (eq (nth 1 a) 'custom-group)
+	      (not (eq (nth 1 b) 'custom-group)))
+	 nil)
+	((and (eq (nth 1 b) 'custom-group)
+	      (not (eq (nth 1 a) 'custom-group)))
+	 t)
+	(t
+	 (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))))))
+(defcustom custom-menu-sort-predicate 'custom-menu-sort-alphabetically
+"Function used for sorting group members in menus.
+The value should be useful as a predicate for `sort'.
+The list to be sorted is the value of the groups `custom-group' property."
+:type '(radio (function-item custom-menu-sort-alphabetically)
+		(function :tag "Other"))
+:group 'customize)
+(defun custom-menu-sort-alphabetically (a b)
+"Return t iff is A should be before B.
+A and B should be members of a `custom-group' property.
+The members are sorted alphabetically, except that all groups are
+sorted before all non-groups."
+(cond ((and (eq (nth 1 a) 'custom-group)
+	      (not (eq (nth 1 b) 'custom-group)))
+	 t)
+	((and (eq (nth 1 b) 'custom-group)
+	      (not (eq (nth 1 a) 'custom-group)))
+	 nil)
+	(t
+	 (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))))))
 ;;; Custom Mode Commands.
 (defvar custom-options nil
 "Customization widgets in the current buffer.")
 				custom-reset-menu
 				event)))
 (if answer
 	(funcall answer))))
-(defun custom-reset-current ()
+(defun custom-reset-current (&rest ignore)
 "Reset all modified group members to their current value."
 (interactive)
 (let ((children custom-options))
 (mapcar (lambda (child)
 	      (when (eq (widget-get child :custom-state) 'modified)
 		(widget-apply child :custom-reset-current)))
 	    children)))
-(defun custom-reset-saved ()
+(defun custom-reset-saved (&rest ignore)
 "Reset all modified or set group members to their saved value."
 (interactive)
 (let ((children custom-options))
 (mapcar (lambda (child)
 	      (when (eq (widget-get child :custom-state) 'modified)
 		(widget-apply child :custom-reset-current)))
 	    children)))
-(defun custom-reset-standard ()
+(defun custom-reset-standard (&rest ignore)
 "Reset all modified, set, or saved group members to their standard settings."
 (interactive)
 (let ((children custom-options))
 (mapcar (lambda (child)
 	      (when (eq (widget-get child :custom-state) 'modified)
 (custom-buffer-create-other-window
 (list (list symbol 'custom-group))
 (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol))))
 ;;;###autoload
-(defun customize-variable (symbol)
+(defalias 'customize-variable 'customize-option)
-"Customize SYMBOL, which must be a variable."
+;;;###autoload
+(defun customize-option (symbol)
+"Customize SYMBOL, which must be a user option variable."
 (interactive (custom-variable-prompt))
 (custom-buffer-create (list (list symbol 'custom-variable))
-			(format "*Customize Variable: %s*"
+			(format "*Customize Option: %s*"
 				(custom-unlispify-tag-name symbol))))
 ;;;###autoload
-(defun customize-variable-other-window (symbol)
+(defalias 'customize-variable-other-window 'customize-option-other-window)
-"Customize SYMBOL, which must be a variable.
+;;;###autoload
+(defun customize-option-other-window (symbol)
+"Customize SYMBOL, which must be a user option variable.
 Show the buffer in another window, but don't select it."
 (interactive (custom-variable-prompt))
 (custom-buffer-create-other-window
 (list (list symbol 'custom-variable))
-(format "*Customize Variable: %s*" (custom-unlispify-tag-name symbol))))
+(format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
 ;;;###autoload
 (defun customize-face (&optional symbol)
 "Customize SYMBOL, which should be a face name or nil.
 If SYMBOL is nil, customize all faces."
 (kill-buffer (get-buffer-create name))
 (let ((window (selected-window)))
 (switch-to-buffer-other-window (get-buffer-create name))
 (custom-buffer-create-internal options)
 (select-window window)))
+(defcustom custom-reset-button-menu nil
+"If non-nil, only show a single reset button in customize buffers.
+This button will have a menu with all three reset operations."
+:type 'boolean
+:group 'customize)
 (defun custom-buffer-create-internal (options)
 (message "Creating customization buffer...")
 (custom-mode)
 (widget-insert "This is a customization buffer.
 Push RET or click mouse-2 on the word ")
-;; (put-text-property 1 2 'start-open nil)
 (widget-create 'info-link
 		 :tag "help"
 		 :help-echo "Read the online help."
-		 "(custom)The Customization Buffer")
+		 "(emacs)Easy Customization")
 (widget-insert " for more information.\n\n")
 (message "Creating customization buttons...")
 (widget-create 'push-button
 		 :tag "Set"
 		 :help-echo "Set all modifications for this session."
 		 :help-echo "\
 Make the modifications default for future sessions."
 		 :action (lambda (widget &optional event)
 			   (custom-save)))
 (widget-insert " ")
-(widget-create 'push-button
+(if custom-reset-button-menu
-		 :tag "Reset"
+(widget-create 'push-button
-		 :help-echo "Undo all modifications."
+		     :tag "Reset"
-		 :action (lambda (widget &optional event)
+		     :help-echo "Show a menu with reset operations."
-			   (custom-reset event)))
+		     :mouse-down-action (lambda (&rest junk) t)
+		     :action (lambda (widget &optional event)
+			       (custom-reset event)))
+(widget-create 'push-button
+		   :tag "Reset"
+		   :help-echo "\
+Reset all visible items in this buffer to their current settings."
+		   :action 'custom-reset-current)
+(widget-insert " ")
+(widget-create 'push-button
+		   :tag "Reset to Saved"
+		   :help-echo "\
+Reset all visible items in this buffer to their saved settings."
+		   :action 'custom-reset-saved)
+(widget-insert " ")
+(widget-create 'push-button
+		   :tag "Reset to Standard"
+		   :help-echo "\
+Reset all visible items in this buffer to their standard settings."
+		   :action 'custom-reset-standard))
 (widget-insert " ")
 (widget-create 'push-button
 		 :tag "Done"
 		 :help-echo "Bury the buffer."
 		 :action (lambda (widget &optional event)
 (message "Creating customization magic...")
 (mapcar 'custom-magic-reset custom-options)
 (message "Creating customization setup...")
 (widget-setup)
 (goto-char (point-min))
-(when (fboundp 'map-extents)
-;; This horrible kludge should make bob and eob read-only in XEmacs.
-(map-extents (lambda (extent &rest junk)
-		   (set-extent-property extent 'start-closed t))
-		 nil (point-min) (1+ (point-min)))
-(map-extents (lambda (extent &rest junk)
-		   (set-extent-property extent 'end-closed t))
-		 nil (1- (point-max)) (point-max)))
 (message "Creating customization buffer...done"))
 ;;; Modification of Basic Widgets.
 ;;
 ;; We add extra properties to the basic widgets needed here.  This is
 (defconst custom-magic-alist '((nil "#" underline "\
 uninitialized, you should not see this.")
 			       (unknown "?" italic "\
 unknown, you should not see this.")
 			       (hidden "-" default "\
-hidden, activate the state button to show." "\
+hidden, invoke the dots above to show." "\
-the group members are hidden, activate the state button to show them.")
+group now hidden, invoke the dots above to show contents.")
 			       (invalid "x" custom-invalid-face "\
-the value displayed for this item is invalid and cannot be set.")
+the value displayed for this %c is invalid and cannot be set.")
 			       (modified "*" custom-modified-face "\
-you have edited the item, and can now set it." "\
+you have edited the value, and can now set the %c." "\
 you have edited something in this group, and can now set it.")
 			       (set "+" custom-set-face "\
-you have set this item, but not saved it." "\
+you have set this %c, but not saved it." "\
 something in this group has been set, but not yet saved.")
 			       (changed ":" custom-changed-face "\
-this item has been changed outside customize." "\
+this %c has been changed outside the customize buffer." "\
 something in this group has been changed outside customize.")
 			       (saved "!" custom-saved-face "\
-this item has been set and saved." "\
+this %c has been set and saved." "\
 something in this group has been set and saved.")
 			       (rogue "@" custom-rogue-face "\
-this item has not been changed with customize." "\
+this %c has not been changed with customize." "\
 something in this group is not prepared for customization.")
 			       (standard " " nil "\
-this item is unchanged from its standard setting." "\
+this %c is unchanged from its standard setting." "\
-the visible members of this group are all at their standard settings."))
+visible group members are all at standard settings."))
 "Alist of customize option states.
 Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
 STATE is one of the following symbols:
 ITEM-DESC is a string describing the state for options.
 GROUP-DESC is a string describing the state for groups.  If this is
 left out, ITEM-DESC will be used.
+The string %c in either description will be replaced with the
+category of the item.  These are `group'. `option', and `face'.
 The list should be sorted most significant first.")
 (defcustom custom-magic-show 'long
-"Show long description of the state of each customization option."
+"If non-nil, show textual description of the state.
+If non-nil and not the symbol `long', only show first word."
 :type '(choice (const :tag "no" nil)
 		 (const short)
 		 (const long))
+:group 'customize)
+(defcustom custom-magic-show-hidden '(option face)
+"Control whether the state button is shown for hidden items.
+The value should be a list with the custom categories where the state
+button should be visible.  Possible categories are `group', `option',
+and `face'."
+:type '(set (const group) (const option) (const face))
 :group 'customize)
 (defcustom custom-magic-show-button nil
 "Show a magic button indicating the state of each customization option."
 :type 'boolean
 (defun custom-magic-value-create (widget)
 ;; Create compact status report for WIDGET.
 (let* ((parent (widget-get widget :parent))
 	 (state (widget-get parent :custom-state))
+	 (hidden (eq state 'hidden))
 	 (entry (assq state custom-magic-alist))
 	 (magic (nth 1 entry))
 	 (face (nth 2 entry))
-	 (text (or (and (eq (widget-type parent) 'custom-group)
+	 (category (widget-get parent :custom-category))
+	 (text (or (and (eq category 'group)
 			(nth 4 entry))
 		   (nth 3 entry)))
 	 (lisp (eq (widget-get parent :custom-form) 'lisp))
 	 children)
-(when custom-magic-show
+(while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
+(setq text (concat (match-string 1 text)
+			 (symbol-name category)
+			 (match-string 2 text))))
+(when (and custom-magic-show
+	       (or (not hidden)
+		   (memq category custom-magic-show-hidden)))
+(insert "   ")
 (push (widget-create-child-and-convert
 	     widget 'choice-item
-	     :help-echo "\
+	     :help-echo "Change the state of this item."
-Change the state of this item."
+	     :format (if hidden "%t" "%[%t%]")
-	     :format "%[%t%]"
+	     :button-prefix 'widget-push-button-prefix
+	     :button-suffix 'widget-push-button-suffix
 	     :mouse-down-action 'widget-magic-mouse-down-action
 	     :tag "State")
 	    children)
 (insert ": ")
 (if (eq custom-magic-show 'long)
 	    (insert-char ?  indent))))
 (push (widget-create-child-and-convert
 	     widget 'choice-item
 	     :mouse-down-action 'widget-magic-mouse-down-action
 	     :button-face face
+	     :button-prefix ""
+	     :button-suffix ""
 	     :help-echo "Change the state."
-	     :format "%[%t%]"
+	     :format (if hidden "%t" "%[%t%]")
 	     :tag (if lisp
 		      (concat "(" magic ")")
 		    (concat "[" magic "]")))
 	    children)
 (insert " "))
 (let* ((buttons (widget-get widget :buttons))
 	 (state (widget-get widget :custom-state))
 	 (level (widget-get widget :custom-level)))
 (cond ((eq escape ?l)
 	   (when level
-	     (push (widget-create-child-and-convert
+	     (insert-char ?\  (1- level))
-		    widget 'item :format "%v " (make-string level ?*))
+	     (if (eq state 'hidden)
-		   buttons)
+		 (insert-char ?- (1+ level))
-	     (widget-put widget :buttons buttons)))
+	       (insert "/")
+	       (insert-char ?- level))))
+	  ((eq escape ?e)
+	   (when (and level (not (eq state 'hidden)))
+	     (insert "\n")
+	     (insert-char ?\  (1- level))
+	     (insert "\\")
+	     (insert-char ?-  level)
+	     (insert " " (widget-get widget :tag) " group end ")
+	     (insert-char ?- (- 75 (current-column) level))
+	     (insert "/\n")))
+	  ((eq escape ?-)
+	   (when (and level (not (eq state 'hidden)))
+	     (insert-char ?- (- 76 (current-column) level))
+	     (insert "\\")))
 	  ((eq escape ?L)
-	   (when (eq state 'hidden)
+	   (push (widget-create-child-and-convert
-	     (widget-insert " ...")))
+		  widget 'visibility
+		  :action 'custom-toggle-parent
+		  (not (eq state 'hidden)))
+		 buttons))
 	  ((eq escape ?m)
 	   (and (eq (preceding-char) ?\n)
 		(widget-get widget :indent)
 		(insert-char ?  (widget-get widget :indent)))
 	   (let ((magic (widget-create-child-and-convert
 			 widget 'custom-magic nil)))
 	     (widget-put widget :custom-magic magic)
 	     (push magic buttons)
 	     (widget-put widget :buttons buttons)))
 	  ((eq escape ?a)
-	   (let* ((symbol (widget-get widget :value))
+	   (unless (eq state 'hidden)
-		  (links (get symbol 'custom-links))
+	     (let* ((symbol (widget-get widget :value))
-		  (many (> (length links) 2)))
+		    (links (get symbol 'custom-links))
-	     (when links
+		    (many (> (length links) 2)))
-	       (and (eq (preceding-char) ?\n)
+	       (when links
-		    (widget-get widget :indent)
+		 (and (eq (preceding-char) ?\n)
-		    (insert-char ?  (widget-get widget :indent)))
+		      (widget-get widget :indent)
-	       (insert "See also ")
+		      (insert-char ?  (widget-get widget :indent)))
-	       (while links
+		 (insert "See also ")
-		 (push (widget-create-child-and-convert widget (car links))
+		 (while links
-		       buttons)
+		   (push (widget-create-child-and-convert widget (car links))
-		 (setq links (cdr links))
+			 buttons)
-		 (cond ((null links)
+		   (setq links (cdr links))
-			(insert ".\n"))
+		   (cond ((null links)
-		       ((null (cdr links))
+			  (insert ".\n"))
-			(if many
+			 ((null (cdr links))
-			    (insert ", and ")
+			  (if many
-			  (insert " and ")))
+			      (insert ", and ")
-		       (t
+			    (insert " and ")))
-			(insert ", "))))
+			 (t
-	       (widget-put widget :buttons buttons))))
+			  (insert ", "))))
+		 (widget-put widget :buttons buttons)))))
 	  (t
 	   (widget-default-format-handler widget escape)))))
 (defun custom-notify (widget &rest args)
 "Keep track of changes."
-(unless (memq (widget-get widget :custom-state) '(nil unknown hidden))
+(let ((state (widget-get widget :custom-state)))
-(widget-put widget :custom-state 'modified))
+(unless (eq state 'modified)
-(let ((buffer-undo-list t))
+(unless (memq state '(nil unknown hidden))
-(custom-magic-reset widget))
+	(widget-put widget :custom-state 'modified))
-(apply 'widget-default-notify widget args))
+(custom-magic-reset widget)
+(apply 'widget-default-notify widget args))))
 (defun custom-redraw (widget)
 "Redraw WIDGET with current settings."
 (let ((line (count-lines (point-min) (point)))
 	(column (current-column))
 	      loads (cdr loads))
 	(cond ((symbolp load)
 	       (condition-case nil
 		   (require load)
 		 (error nil)))
+	      ;; Don't reload a file already loaded.
 	      ((assoc load load-history))
+	      ((assoc (locate-library load) load-history))
 	      (t
 	       (condition-case nil
-		   (load-library load)
+		   ;; Without this, we would load cus-edit recursively.
+		   ;; We are still loading it when we call this,
+		   ;; and it is not in load-history yet.
+		   (or (equal load "cus-edit")
+		       (load-library load))
 		 (error nil))))))))
 (defun custom-load-widget (widget)
 "Load all dependencies for WIDGET."
 (custom-load-symbol (widget-value widget)))
 (cond ((memq state '(invalid modified))
 	   (error "There are unset changes"))
 	  ((eq state 'hidden)
 	   (widget-put widget :custom-state 'unknown))
 	  (t
+	   (widget-put widget :documentation-shown nil)
 	   (widget-put widget :custom-state 'hidden)))
 (custom-redraw widget)))
+(defun custom-toggle-parent (widget &rest ignore)
+"Toggle visibility of parent to WIDGET."
+(custom-toggle-hide (widget-get widget :parent)))
 ;;; The `custom-variable' Widget.
 (defface custom-variable-sample-face '((t (:underline t)))
 "Face used for unpushable variable tags."
 (define-widget 'custom-variable 'custom
 "Customize variable."
 :format "%v%m%h%a"
 :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
 :value-create 'custom-variable-value-create
 :action 'custom-variable-action
 ;; Now we can create the child widget.
 (cond ((eq state 'hidden)
 	   ;; Indicate hidden value.
 	   (push (widget-create-child-and-convert
 		  widget 'item
-		  :format "%{%t%}: ..."
+		  :format "%{%t%}: "
 		  :sample-face 'custom-variable-sample-face
 		  :tag tag
 		  :parent widget)
-		 children))
+		 buttons)
+	   (push (widget-create-child-and-convert
+		  widget 'visibility
+		  :action 'custom-toggle-parent
+		  nil)
+		 buttons))
 	  ((eq form 'lisp)
 	   ;; In lisp mode edit the saved value when possible.
 	   (let* ((value (cond ((get symbol 'saved-value)
 				(car (get symbol 'saved-value)))
 			       ((get symbol 'standard-value)
 				(car (get symbol 'standard-value)))
 			       ((default-boundp symbol)
 				(custom-quote (funcall get symbol)))
 			       (t
 				(custom-quote (widget-get conv :value))))))
+	     (insert (symbol-name symbol) ": ")
+	     (push (widget-create-child-and-convert
+		  widget 'visibility
+		  :action 'custom-toggle-parent
+		  t)
+		 buttons)
+	     (insert " ")
 	     (push (widget-create-child-and-convert
 		    widget 'sexp
 		    :button-face 'custom-variable-button-face
+		    :format "%v"
 		    :tag (symbol-name symbol)
 		    :parent widget
 		    :value value)
 		   children)))
 	  (t
 	   ;; Edit mode.
-	   (push (widget-create-child-and-convert
+	   (let* ((format (widget-get type :format))
-		  widget type
+		  tag-format value-format)
-		  :tag tag
+	     (unless (string-match ":" format)
-		  :button-face 'custom-variable-button-face
+	       (error "Bad format."))
-		  :sample-face 'custom-variable-sample-face
+	     (setq tag-format (substring format 0 (match-end 0)))
-		  :value value)
+	     (setq value-format (substring format (match-end 0)))
-		 children)))
+	     (push (widget-create-child-and-convert
+		    widget 'item
+		    :format tag-format
+		    :action 'custom-tag-action
+		    :mouse-down-action 'custom-tag-mouse-down-action
+		    :button-face 'custom-variable-button-face
+		    :sample-face 'custom-variable-sample-face
+		    tag)
+		   buttons)
+	     (insert " ")
+	     (push (widget-create-child-and-convert
+		  widget 'visibility
+		  :action 'custom-toggle-parent
+		  t)
+		 buttons)
+	     (push (widget-create-child-and-convert
+		    widget type
+		    :format value-format
+		    :value value)
+		   children))))
 ;; Now update the state.
 (unless (eq (preceding-char) ?\n)
 (widget-insert "\n"))
 (if (eq state 'hidden)
 	(widget-put widget :custom-state state)
 (custom-variable-state-set widget))
 (widget-put widget :custom-form form)
 (widget-put widget :buttons buttons)
 (widget-put widget :children children)))
+(defun custom-tag-action (widget &rest args)
+"Pass :action to first child of WIDGET's parent."
+(apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+	 :action args))
+(defun custom-tag-mouse-down-action (widget &rest args)
+"Pass :mouse-down-action to first child of WIDGET's parent."
+(apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
+	 :mouse-down-action args))
 (defun custom-variable-state-set (widget)
 "Set the state of WIDGET."
 (let* ((symbol (widget-value widget))
 	 (get (or (get symbol 'custom-get) 'default-value))
 			 'changed))
 		      (t 'rogue))))
 (widget-put widget :custom-state state)))
 (defvar custom-variable-menu
-'(("Hide" custom-toggle-hide
+'(("Edit" custom-variable-edit
-(lambda (widget)
-(not (memq (widget-get widget :custom-state) '(modified invalid)))))
-("Edit" custom-variable-edit
 (lambda (widget)
 (not (eq (widget-get widget :custom-form) 'edit))))
 ("Edit Lisp" custom-variable-edit-lisp
 (lambda (widget)
 (not (eq (widget-get widget :custom-form) 'lisp))))
 (custom-toggle-hide widget)
 (unless (eq (widget-get widget :custom-state) 'modified)
 (custom-variable-state-set widget))
 (custom-redraw-magic widget)
 (let* ((completion-ignore-case t)
-	   (answer (widget-choose (custom-unlispify-tag-name
+	   (answer (widget-choose (concat "Operation on "
-				   (widget-get widget :value))
+					  (custom-unlispify-tag-name
+					   (widget-get widget :value)))
 				  (custom-menu-filter custom-variable-menu
 						      widget)
 				  event)))
 (if answer
 	  (funcall answer widget)))))
 "Face used for face tags."
 :group 'custom-faces)
 (define-widget 'custom-face 'custom
 "Customize face."
-:format "%{%t%}: %s%m%h%a%v"
+:format "%{%t%}: %s %L\n%m%h%a%v"
 :format-handler 'custom-face-format-handler
 :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-set 'custom-face-set
 :custom-save 'custom-face-save
 :custom-reset-current 'custom-redraw
 :custom-reset-saved 'custom-face-reset-saved
 		;; XEmacs cannot display initialized faces.
 		(not (custom-facep symbol))
 		(copy-face 'custom-face-empty symbol))
 	   (setq child (widget-create-child-and-convert
 			widget 'item
-			:format "(%{%t%})\n"
+			:format "(%{%t%})"
 			:sample-face symbol
 			:tag "sample")))
 	  (t
 	   (custom-format-handler widget escape)))
 (when child
 (custom-face-state-set widget)
 (widget-put widget :children (list edit)))
 (message "Creating face editor...done")))
 (defvar custom-face-menu
-'(("Hide" custom-toggle-hide
+'(("Edit Selected" custom-face-edit-selected
-(lambda (widget)
-(not (memq (widget-get widget :custom-state) '(modified invalid)))))
-("Edit Selected" custom-face-edit-selected
 (lambda (widget)
 (not (eq (widget-get widget :custom-form) 'selected))))
 ("Edit All" custom-face-edit-all
 (lambda (widget)
 (not (eq (widget-get widget :custom-form) 'all))))
 Optional EVENT is the location for the menu."
 (if (eq (widget-get widget :custom-state) 'hidden)
 (custom-toggle-hide widget)
 (let* ((completion-ignore-case t)
 	   (symbol (widget-get widget :value))
-	   (answer (widget-choose (custom-unlispify-tag-name symbol)
+	   (answer (widget-choose (concat "Operation on "
+					  (custom-unlispify-tag-name symbol))
 				  (custom-menu-filter custom-face-menu
 						      widget)
 				  event)))
 (if answer
 	  (funcall answer widget)))))
 "Make the face attributes in WIDGET take effect."
 (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
 	 (value (widget-value child)))
 (put symbol 'customized-face value)
-(custom-face-display-set symbol value)
+(face-spec-set symbol value)
 (custom-face-state-set widget)
 (custom-redraw-magic widget)))
 (defun custom-face-save (widget)
 "Make the face attributes in WIDGET default."
 (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
 	 (value (widget-value child)))
-(custom-face-display-set symbol value)
+(face-spec-set symbol value)
 (put symbol 'saved-face value)
 (put symbol 'customized-face nil)
 (custom-face-state-set widget)
 (custom-redraw-magic widget)))
 	 (child (car (widget-get widget :children)))
 	 (value (get symbol 'saved-face)))
 (unless value
 (error "No saved value for this face"))
 (put symbol 'customized-face nil)
-(custom-face-display-set symbol value)
+(face-spec-set symbol value)
 (widget-value-set child value)
 (custom-face-state-set widget)
 (custom-redraw-magic widget)))
 (defun custom-face-reset-standard (widget)
 (error "No standard setting for this face"))
 (put symbol 'customized-face nil)
 (when (get symbol 'saved-face)
 (put symbol 'saved-face nil)
 (custom-save-all))
-(custom-face-display-set symbol value)
+(face-spec-set symbol value)
 (widget-value-set child value)
 (custom-face-state-set widget)
 (custom-redraw-magic widget)))
 ;;; The `face' Widget.
 (defun widget-face-value-create (widget)
 ;; Create a `custom-face' child.
 (let* ((symbol (widget-value widget))
 	 (child (widget-create-child-and-convert
 		 widget 'custom-face
-		 :format "%t %s%m%h%v"
+		 :format "%t %s %L\n%m%h%v"
 		 :custom-level nil
 		 :value symbol)))
 (custom-magic-reset child)
 (setq custom-options (cons child custom-options))
 (widget-put widget :children (list child))))
 "Face used for low level group tags."
 :group 'custom-faces)
 (define-widget 'custom-group 'custom
 "Customize group."
-:format "%l%{%t%}:%L\n%m%h%a%v"
+:format "%l %{%t%} group: %L %-\n%m%h%a%v%e"
 :sample-face-get 'custom-group-sample-face-get
 :documentation-property 'group-documentation
 :help-echo "Set or reset all members of this group."
 :value-create 'custom-group-value-create
 :action 'custom-group-action
+:custom-category 'group
 :custom-set 'custom-group-set
 :custom-save 'custom-group-save
 :custom-reset-current 'custom-group-reset-current
 :custom-reset-saved 'custom-group-reset-saved
 :custom-reset-standard 'custom-group-reset-standard
 (unless (eq state 'hidden)
 (message "Creating group...")
 (custom-load-widget widget)
 (let* ((level (widget-get widget :custom-level))
 	     (symbol (widget-value widget))
-	     (members (get symbol 'custom-group))
+	     (members (sort (get symbol 'custom-group)
+			    custom-buffer-sort-predicate))
 	     (prefixes (widget-get widget :custom-prefixes))
 	     (custom-prefix-list (custom-prefix-add symbol prefixes))
 	     (length (length members))
 	     (count 0)
 	     (children (mapcar (lambda (entry)
 				      :custom-level (1+ level)
 				      :value (nth 0 entry))
 				   (unless (eq (preceding-char) ?\n)
 				     (widget-insert "\n"))))
 			       members)))
+	(put symbol 'custom-group members)
 	(message "Creating group magic...")
 	(mapcar 'custom-magic-reset children)
 	(message "Creating group state...")
 	(widget-put widget :children children)
 	(custom-group-state-update widget)
 	(message "Creating group... done")))))
 (defvar custom-group-menu
-'(("Hide" custom-toggle-hide
+'(("Set" custom-group-set
-(lambda (widget)
-(not (memq (widget-get widget :custom-state) '(modified invalid)))))
-("Set" custom-group-set
 (lambda (widget)
 (eq (widget-get widget :custom-state) 'modified)))
 ("Save" custom-group-save
 (lambda (widget)
 (memq (widget-get widget :custom-state) '(modified set))))
 "Show the menu for `custom-group' WIDGET.
 Optional EVENT is the location for the menu."
 (if (eq (widget-get widget :custom-state) 'hidden)
 (custom-toggle-hide widget)
 (let* ((completion-ignore-case t)
-	   (answer (widget-choose (custom-unlispify-tag-name
+	   (answer (widget-choose (concat "Operation on "
-				   (widget-get widget :value))
+					  (custom-unlispify-tag-name
+					   (widget-get widget :value)))
 				  (custom-menu-filter custom-group-menu
 						      widget)
 				  event)))
 (if answer
 	  (funcall answer widget)))))
 ;;; Menu support
 (unless (string-match "XEmacs" emacs-version)
 (defconst custom-help-menu '("Customize"
 			       ["Update menu..." custom-menu-update t]
-			       ["Group..." customize t]
+			       ["Group..." customize-group t]
 			       ["Variable..." customize-variable t]
 			       ["Face..." customize-face t]
-			       ["Saved..." customize-customized t]
+			       ["Saved..." customize-saved t]
+			       ["Set..." customize-customized t]
 			       ["Apropos..." customize-apropos t])
 ;; This menu should be identical to the one defined in `menu-bar.el'.
 "Customize menu")
 (defun custom-menu-reset ()
 		       t)))
 (if (and (or (not (boundp 'custom-menu-nesting))
 		 (>= custom-menu-nesting 0))
 	     (< (length (get symbol 'custom-group)) widget-menu-max-size))
 	(let ((custom-prefix-list (custom-prefix-add symbol
-						     custom-prefix-list)))
+						     custom-prefix-list))
+	      (members (sort (get symbol 'custom-group)
+			     custom-menu-sort-predicate)))
+	  (put symbol 'custom-group members)
 	  (custom-load-symbol symbol)
 	  `(,(custom-unlispify-menu-entry symbol t)
 	    ,item
 	    "--"
 	    ,@(mapcar (lambda (entry)
 			(widget-apply (if (listp (nth 1 entry))
 					  (nth 1 entry)
 					(list (nth 1 entry)))
 				      :custom-menu (nth 0 entry)))
-		      (get symbol 'custom-group))))
+		      members)))
 item)))
 ;;;###autoload
 (defun customize-menu-create (symbol &optional name)
 "Return a customize menu for customization group SYMBOL.
 The following commands are available:
 Move to next button or editable field.     \\[widget-forward]
 Move to previous button or editable field. \\[widget-backward]
-Activate button under the mouse pointer.   \\[widget-button-click]
+Invoke button under the mouse pointer.     \\[widget-button-click]
-Activate button under point.		   \\[widget-button-press]
+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]
 Reset all options.			   \\[custom-reset-standard]

Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-edit.el @ 155:43dd3413c7c7 r20-3b4