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

comparison 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

comparison

equal deleted inserted replaced

-:a38aed19690b
+:8eaf7971accc
 ;;
 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 ;;
 ;; 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.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 				       "Set customized value for %s to: "))
 (funcall (or (get var 'custom-set) 'set-default) var val)
 (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\".
 Initially the top-level group `Emacs' and its immediate subgroups
 are shown; the contents of those subgroups are initially hidden."
 (let ((name (format "*Customize Group: %s*"
 		      (custom-unlispify-tag-name group))))
 (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)
 "Customize SYMBOL, which must be a customization group."
 (interactive (list (completing-read "Customize group: (default emacs) "
 (defun customize-customized ()
 "Customize all user options set since the last save in this session."
 (interactive)
 (let ((found nil))
 (mapatoms (lambda (symbol)
-		(and (condition-case nil
+		(and (get symbol 'customized-face)
-			 (get symbol 'customized-face)
-		       (t (progn
-			    (message "Bad plist in %s"
-				     (symbol-name symbol))
-			    nil)))
 		     (custom-facep symbol)
 		     (push (list symbol 'custom-face) found))
 		(and (get symbol 'customized-value)
 		     (boundp symbol)
 		     (push (list symbol 'custom-variable) found))))
 (defun customize-saved ()
 "Customize all already saved user options."
 (interactive)
 (let ((found nil))
 (mapatoms (lambda (symbol)
-		(and (condition-case nil
+		(and (get symbol 'saved-face)
-			 (get symbol 'saved-face)
-		       (t (progn
-			    (message "Bad plist in %s"
-				     (symbol-name symbol))
-			    nil)))
 		     (custom-facep symbol)
 		     (push (list symbol 'custom-face) found))
 		(and (get symbol 'saved-value)
 		     (boundp symbol)
 		     (push (list symbol 'custom-variable) found))))
 "Number of spaces to indent nested groups."
 :type 'integer
 :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
 SYMBOL is a customization option, and WIDGET is a widget for editing
 that option."
 (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
 SYMBOL is a customization option, and WIDGET is a widget for editing
 that option."
 (unless name (setq name "*Customization*"))
 (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
 "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 '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."
 		 "(emacs)Easy Customization")
 (widget-insert " for more information.\n\n")
 (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
+(progn
-		     :tag "Reset"
+	(widget-insert " ")
-		     :help-echo "Show a menu with reset operations."
+	(widget-create 'push-button
-		     :mouse-down-action (lambda (&rest junk) t)
+		       :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-insert "\n ")
 (widget-create 'push-button
 		   :tag "Reset"
 		   :help-echo "\
 Reset all edited text in this buffer to reflect current values."
 		   :action 'Custom-reset-current)
 			    (widget-insert "\n"))
 			  (widget-insert "\n")))
 		      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...")
 (widget-setup)
 (goto-char (point-min))
 (let ((name "*Customize Browser*"))
 (kill-buffer (get-buffer-create name))
 (switch-to-buffer (get-buffer-create name)))
 (custom-mode)
 (widget-insert "\
-Invoke [+] or [?] below to expand items, and [-] to collapse items.
+Invoke [+] or [?] below to expand items, and [-] to collapse items.\n")
-Invoke the [Group], [Face], and [Option] buttons below to edit that
+(if custom-browse-only-groups
-item in another window.\n\n")
+(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
 		   :custom-state 'unknown
 		   :tag (custom-unlispify-tag-name group)
 hidden, invoke \"Show\" in the previous line to show." "\
 group now hidden, invoke \"Show\", above, to show contents.")
 			       (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 the value as text, but you have not set the %c." "\
-you have edited something in this group, and can now set it.")
+you have edited something in this group, but not set it.")
 			       (set "+" custom-set-face "\
-you have set this %c, but not saved it." "\
+you have set this %c, but not saved it for future sessions." "\
-something in this group has been set, but not yet saved.")
+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.")
 			       (saved "!" custom-saved-face "\
 this %c has been set and saved." "\
 :documentation-property 'widget-subclass-responsibility
 :value-create 'widget-subclass-responsibility
 :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)
 ;; Initialize :value and :tag from :args in WIDGET.
 (let ((args (widget-get widget :args)))
 	(buttons (widget-get widget :buttons))
 	(start (point))
 	found)
 (insert (or initial-string "Parent groups:"))
 (mapatoms (lambda (symbol)
-		(let ((entry (assq name
+		(let ((entry (assq name (get symbol 'custom-group))))
-				   (condition-case nil
-				       (get symbol 'custom-group)
-				     (t (progn
-					  (message "Bad plist in %s"
-						   (symbol-name symbol))
-					  nil))))))
 		  (when (eq (nth 1 entry) type)
 		    (insert " ")
 		    (push (widget-create-child-and-convert
 			   widget 'custom-group-link
 			   :tag (custom-unlispify-tag-name symbol)
 			 'changed))
 		      (t 'rogue))))
 (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
 (lambda (widget)
 (and (default-boundp (widget-value widget))
 	       (custom-face-state-set widget)
 	       (widget-put widget :children (list edit)))
 	     (message "Creating face editor...done"))))))
 (defvar custom-face-menu
-'(("Set" custom-face-set)
+'(("Set for Current Session" custom-face-set)
-("Save" custom-face-save)
+("Save for Future Sessions" custom-face-save)
 ("Reset to Saved" custom-face-reset-saved
 (lambda (widget)
 (get (widget-value widget) 'saved-face)))
 ("Reset to Standard Setting" custom-face-reset-standard
 (lambda (widget)
 (let ((visible (widget-value widget)))
 (if visible
 	(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))
+(let* ((state (widget-get widget :custom-state))
-	(level (widget-get widget :custom-level))
+	 (level (widget-get widget :custom-level))
-	(indent (widget-get widget :indent))
+	 (indent (widget-get widget :indent))
-	(prefix (widget-get widget :custom-prefix))
+	 (prefix (widget-get widget :custom-prefix))
-	(buttons (widget-get widget :buttons))
+	 (buttons (widget-get widget :buttons))
-	(tag (widget-get widget :tag))
+	 (tag (widget-get widget :tag))
-	(symbol (widget-value widget)))
+	 (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)
+		(or members (custom-unloaded-widget-p widget)))
-		    (custom-unloaded-widget-p widget)))
 	   (custom-browse-insert-prefix prefix)
 	   (push (widget-create-child-and-convert
 		  widget 'custom-browse-visibility
 		  ;; :tag-glyph "plus"
 		  :tag (if (custom-unloaded-widget-p widget) "?" "+"))
 		  widget 'custom-browse-group-tag)
 		 buttons)
 	   (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")
 	   ;; (widget-glyph-insert nil "-- " "horizontal")
 	   (push (widget-create-child-and-convert
 	   (insert " " tag "\n")
 	   (widget-put widget :buttons buttons))
 	  ((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 "[ ]-- ")
 		 ;; (widget-glyph-insert nil "[ ]" "empty")
 		 ;; (widget-glyph-insert nil "-- " "horizontal")
 		    widget 'custom-browse-group-tag)
 		   buttons)
 	     (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))
 		    (custom-prefix-list (custom-prefix-add symbol prefixes))
 		    (extra-prefix (if (widget-get widget :custom-last)
 		    (prefix (concat prefix extra-prefix))
 		    children entry)
 	       (while members
 		 (setq entry (car members)
 		       members (cdr members))
-		 (when (or (not custom-browse-only-groups)
+		 (push (widget-create-child-and-convert
-			   (eq (nth 1 entry) 'custom-group))
+			widget (nth 1 entry)
-		   (push (widget-create-child-and-convert
+			:group widget
-			  widget (nth 1 entry)
+			:tag (custom-unlispify-tag-name (nth 0 entry))
-			  :group widget
+			:custom-prefixes custom-prefix-list
-			  :tag (custom-unlispify-tag-name (nth 0 entry))
+			:custom-level (1+ level)
-			  :custom-prefixes custom-prefix-list
+			:custom-last (null members)
-			  :custom-level (1+ level)
+			:value (nth 0 entry)
-			  :custom-last (null members)
+			:custom-prefix prefix)
-			  :value (nth 0 entry)
+		       children))
-			  :custom-prefix prefix)
-			 children)))
 	       (widget-put widget :children (reverse children)))
 	     (message "Creating group...done")))
 	  ;; Nested style.
 	  ((eq state 'hidden)
 	   ;; Create level indicator.
 				(make-string (* custom-buffer-indent level)
 					     ?\ ))
 	   ;; 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))
 		  (custom-prefix-list (custom-prefix-add symbol prefixes))
 		  (length (length members))
 	   (insert "\\- " (widget-get widget :tag) " group end ")
 	   (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
 	   (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
 (lambda (widget)
 (memq (widget-get widget :custom-state) '(modified))))
 (custom-magic-reset widget))
 ;;; 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
 explicitly load that file for the settings to take effect."
 :type 'file
 (let ((standard-output (current-buffer)))
 (unless (bolp)
 	(princ "\n"))
 (princ "(custom-set-variables")
 (mapatoms (lambda (symbol)
-		  (let ((value (condition-case nil
+		  (let ((value (get symbol 'saved-value))
-				   (get symbol 'saved-value)
-				 (t (progn
-				      (message "Bad plist in %s"
-					       (symbol-name symbol))
-				      nil))))
 			(requests (get symbol 'custom-requests))
 			(now (not (or (get symbol 'standard-value)
 				      (and (not (boundp symbol))
 					   (not (get symbol 'force-value)))))))
 		    (when value
 		  (and (not (custom-facep 'default))
 		       (not (get 'default 'force-face))))
 	      (princ ")")
 	    (princ " t)"))))
 (mapatoms (lambda (symbol)
-		  (let ((value (condition-case nil
+		  (let ((value (get symbol 'saved-face)))
-				   (get symbol 'saved-face)
-				 (t (progn
-				      (message "Bad plist in %s"
-					       (symbol-name symbol)))
-				    nil))))
 		    (when (and (not (eq symbol 'default))
 			       ;; Don't print default face here.
 			       value)
 		      (princ "\n '(")
 		      (princ symbol)
 ;;;###autoload
 (defun customize-save-customized ()
 "Save all user options which have been set in this session."
 (interactive)
 (mapatoms (lambda (symbol)
-	      (condition-case nil
+	      (let ((face (get symbol 'customized-face))
-		  (let ((face (get symbol 'customized-face))
+		    (value (get symbol 'customized-value)))
-			(value (get symbol 'customized-value)))
+		(when face
-		    (when face
+		  (put symbol 'saved-face face)
-		      (put symbol 'saved-face face)
+		  (put symbol 'customized-face nil))
-		      (put symbol 'customized-face nil))
+		(when value
-		    (when value
+		  (put symbol 'saved-value value)
-		      (put symbol 'saved-value value)
+		  (put symbol 'customized-value nil)))))
-		      (put symbol 'customized-value nil)))
-		(t (message "Bad plist in %s"
-			    (symbol-name symbol))))))
 ;; 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)
+(let ((inhibit-read-only t))
-(custom-save-faces)
+(custom-save-variables)
-(save-excursion
+(custom-save-faces)
-(set-buffer (find-file-noselect custom-file))
+(save-excursion
-(save-buffer)))
+(set-buffer (find-file-noselect custom-file))
+(save-buffer))))
 ;;; The Customize Menu.
 ;;; Menu support
 (set-keymap-parent 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 "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
 "Menu used in customization buffers."
 `("Custom"
 The following commands are available:
 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]
 Reset all modified options. 		   \\[Custom-reset-current]
 Reset all modified or set options.	   \\[Custom-reset-saved]
 (use-local-map custom-mode-map)
 (easy-menu-add Custom-mode-menu)
 (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))
 ;;; The End.

Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-edit.el @ 173:8eaf7971accc r20-3b13