diff 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
line wrap: on
line diff
--- a/lisp/custom/cus-edit.el	Mon Aug 13 09:47:55 2007 +0200
+++ b/lisp/custom/cus-edit.el	Mon Aug 13 09:49:09 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; 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.
@@ -768,6 +768,26 @@
   (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\".
@@ -795,7 +815,9 @@
     (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)
@@ -879,12 +901,7 @@
   (interactive)
   (let ((found nil))
     (mapatoms (lambda (symbol)
-		(and (condition-case nil
-			 (get symbol 'customized-face)
-		       (t (progn
-			    (message "Bad plist in %s"
-				     (symbol-name symbol))
-			    nil)))
+		(and (get symbol 'customized-face)
 		     (custom-facep symbol)
 		     (push (list symbol 'custom-face) found))
 		(and (get symbol 'customized-value)
@@ -901,12 +918,7 @@
   (interactive)
   (let ((found nil))
     (mapatoms (lambda (symbol)
-		(and (condition-case nil
-			 (get symbol 'saved-face)
-		       (t (progn
-			    (message "Bad plist in %s"
-				     (symbol-name symbol))
-			    nil)))
+		(and (get symbol 'saved-face)
 		     (custom-facep symbol)
 		     (push (list symbol 'custom-face) found))
 		(and (get symbol 'saved-value)
@@ -986,7 +998,7 @@
   :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
@@ -995,10 +1007,10 @@
   (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
@@ -1008,7 +1020,7 @@
   (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
@@ -1017,12 +1029,18 @@
   :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."
@@ -1031,26 +1049,28 @@
   (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
-		     :tag "Reset"
-		     :help-echo "Show a menu with reset operations."
-		     :mouse-down-action (lambda (&rest junk) t)
-		     :action (lambda (widget &optional event)
-			       (custom-reset event)))
+      (progn
+	(widget-insert " ")
+	(widget-create 'push-button
+		       :tag "Reset"
+		       :help-echo "Show a menu with reset operations."
+		       :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 "\
@@ -1103,6 +1123,7 @@
 		      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...")
@@ -1131,9 +1152,27 @@
     (switch-to-buffer (get-buffer-create name)))
   (custom-mode)
   (widget-insert "\
-Invoke [+] or [?] below to expand items, and [-] to collapse items.
-Invoke the [Group], [Face], and [Option] buttons below to edit that
-item in another window.\n\n")
+Invoke [+] or [?] below to expand items, and [-] to collapse items.\n")
+  (if custom-browse-only-groups
+      (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
@@ -1284,11 +1323,11 @@
 			       (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 something in this group, and can now set it.")
+you have edited the value as text, but you have not set the %c." "\
+you have edited something in this group, but not set it.")
 			       (set "+" custom-set-face "\
-you have set this %c, but not saved it." "\
-something in this group has been set, but not yet saved.")
+you have set this %c, but not saved it for future sessions." "\
+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.")
@@ -1485,7 +1524,6 @@
   :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)
@@ -1659,13 +1697,7 @@
 	found)
     (insert (or initial-string "Parent groups:"))
     (mapatoms (lambda (symbol)
-		(let ((entry (assq name
-				   (condition-case nil
-				       (get symbol 'custom-group)
-				     (t (progn
-					  (message "Bad plist in %s"
-						   (symbol-name symbol))
-					  nil))))))
+		(let ((entry (assq name (get symbol 'custom-group))))
 		  (when (eq (nth 1 entry) type)
 		    (insert " ")
 		    (push (widget-create-child-and-convert 
@@ -1900,10 +1932,10 @@
     (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
@@ -2273,8 +2305,8 @@
 	     (message "Creating face editor...done"))))))
 
 (defvar custom-face-menu 
-  '(("Set" custom-face-set)
-    ("Save" custom-face-save)
+  '(("Set for Current Session" custom-face-set)
+    ("Save for Future Sessions" custom-face-save)
     ("Reset to Saved" custom-face-reset-saved
      (lambda (widget)
        (get (widget-value widget) 'saved-face)))
@@ -2538,19 +2570,32 @@
 	(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))
-	(level (widget-get widget :custom-level))
-	(indent (widget-get widget :indent))
-	(prefix (widget-get widget :custom-prefix))
-	(buttons (widget-get widget :buttons))
-	(tag (widget-get widget :tag))
-	(symbol (widget-value widget)))
+  (let* ((state (widget-get widget :custom-state))
+	 (level (widget-get widget :custom-level))
+	 (indent (widget-get widget :indent))
+	 (prefix (widget-get widget :custom-prefix))
+	 (buttons (widget-get widget :buttons))
+	 (tag (widget-get widget :tag))
+	 (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)
-		    (custom-unloaded-widget-p widget)))
+		(or members (custom-unloaded-widget-p widget)))
 	   (custom-browse-insert-prefix prefix)
 	   (push (widget-create-child-and-convert
 		  widget 'custom-browse-visibility 
@@ -2565,7 +2610,7 @@
 	   (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")
@@ -2578,7 +2623,7 @@
 	  ((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 "[ ]-- ")
@@ -2602,7 +2647,7 @@
 	     (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))
@@ -2615,18 +2660,16 @@
 	       (while members
 		 (setq entry (car members)
 		       members (cdr members))
-		 (when (or (not custom-browse-only-groups)
-			   (eq (nth 1 entry) 'custom-group))
-		   (push (widget-create-child-and-convert
-			  widget (nth 1 entry)
-			  :group widget
-			  :tag (custom-unlispify-tag-name (nth 0 entry))
-			  :custom-prefixes custom-prefix-list
-			  :custom-level (1+ level)
-			  :custom-last (null members)
-			  :value (nth 0 entry)
-			  :custom-prefix prefix)
-			 children)))
+		 (push (widget-create-child-and-convert
+			widget (nth 1 entry)
+			:group widget
+			:tag (custom-unlispify-tag-name (nth 0 entry))
+			:custom-prefixes custom-prefix-list
+			:custom-level (1+ level)
+			:custom-last (null members)
+			:value (nth 0 entry)
+			:custom-prefix prefix)
+		       children))
 	       (widget-put widget :children (reverse children)))
 	     (message "Creating group...done")))
 	  ;; Nested style.
@@ -2721,7 +2764,7 @@
 	   ;; 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))
@@ -2760,10 +2803,10 @@
 	   (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
@@ -2860,7 +2903,10 @@
 ;;; 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
@@ -2895,12 +2941,7 @@
 	(princ "\n"))
       (princ "(custom-set-variables")
       (mapatoms (lambda (symbol)
-		  (let ((value (condition-case nil
-				   (get symbol 'saved-value)
-				 (t (progn
-				      (message "Bad plist in %s"
-					       (symbol-name symbol))
-				      nil))))
+		  (let ((value (get symbol 'saved-value))
 			(requests (get symbol 'custom-requests))
 			(now (not (or (get symbol 'standard-value)
 				      (and (not (boundp symbol))
@@ -2943,12 +2984,7 @@
 	      (princ ")")
 	    (princ " t)"))))
       (mapatoms (lambda (symbol)
-		  (let ((value (condition-case nil
-				   (get symbol 'saved-face)
-				 (t (progn
-				      (message "Bad plist in %s"
-					       (symbol-name symbol)))
-				    nil))))
+		  (let ((value (get symbol 'saved-face)))
 		    (when (and (not (eq symbol 'default))
 			       ;; Don't print default face here.
 			       value)
@@ -2970,28 +3006,26 @@
   "Save all user options which have been set in this session."
   (interactive)
   (mapatoms (lambda (symbol)
-	      (condition-case nil
-		  (let ((face (get symbol 'customized-face))
-			(value (get symbol 'customized-value)))
-		    (when face
-		      (put symbol 'saved-face face)
-		      (put symbol 'customized-face nil))
-		    (when value
-		      (put symbol 'saved-value value)
-		      (put symbol 'customized-value nil)))
-		(t (message "Bad plist in %s"
-			    (symbol-name symbol))))))
+	      (let ((face (get symbol 'customized-face))
+		    (value (get symbol 'customized-value)))
+		(when face 
+		  (put symbol 'saved-face face)
+		  (put symbol 'customized-face nil))
+		(when value 
+		  (put symbol 'saved-value value)
+		  (put symbol 'customized-value nil)))))
   ;; 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)
-  (custom-save-faces)
-  (save-excursion
-    (set-buffer (find-file-noselect custom-file))
-    (save-buffer)))
+  (let ((inhibit-read-only t))
+    (custom-save-variables)
+    (custom-save-faces)
+    (save-excursion
+      (set-buffer (find-file-noselect custom-file))
+      (save-buffer))))
 
 ;;; The Customize Menu.
 
@@ -3134,7 +3168,19 @@
   (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
@@ -3175,7 +3221,10 @@
 
 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]
@@ -3193,6 +3242,8 @@
   (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))