diff lisp/custom/cus-edit.el @ 167:85ec50267440 r20-3b10

Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents 5a88923fcbfe
children 929b76928fce
line wrap: on
line diff
--- a/lisp/custom/cus-edit.el	Mon Aug 13 09:44:44 2007 +0200
+++ b/lisp/custom/cus-edit.el	Mon Aug 13 09:45:46 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.9937
+;; Version: 1.9940
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -568,6 +568,11 @@
 		 (const :tag "none" nil))
   :group 'custom-browse)
 
+(defcustom custom-browse-only-groups nil
+  "If non-nil, show group members only within each customization group."
+  :type 'boolean
+  :group 'custom-browse)
+
 (defcustom custom-buffer-sort-alphabetically nil
   "If non-nil, sort members of each customization group alphabetically."
   :type 'boolean
@@ -874,7 +879,12 @@
   (interactive)
   (let ((found nil))
     (mapatoms (lambda (symbol)
-		(and (get symbol 'customized-face)
+		(and (condition-case nil
+			 (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)
@@ -891,7 +901,12 @@
   (interactive)
   (let ((found nil))
     (mapatoms (lambda (symbol)
-		(and (get symbol 'saved-face)
+		(and (condition-case nil
+			 (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)
@@ -1116,7 +1131,7 @@
     (switch-to-buffer (get-buffer-create name)))
   (custom-mode)
   (widget-insert "\
-Invoke [+] below to expand items, and [-] to collapse items.
+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")
   (let ((custom-buffer-style 'tree))
@@ -1127,52 +1142,52 @@
 		   :value group))
   (goto-char (point-min)))
 
-(define-widget 'custom-tree-visibility 'item
+(define-widget 'custom-browse-visibility 'item
   "Control visibility of of items in the customize tree browser."
   :format "%[[%t]%]"
-  :action 'custom-tree-visibility-action)
-
-(defun custom-tree-visibility-action (widget &rest ignore)
+  :action 'custom-browse-visibility-action)
+
+(defun custom-browse-visibility-action (widget &rest ignore)
   (let ((custom-buffer-style 'tree))
     (custom-toggle-parent widget)))
 
-(define-widget 'custom-tree-group-tag 'push-button
+(define-widget 'custom-browse-group-tag 'push-button
   "Show parent in other window when activated."
   :tag "Group"
   :tag-glyph "folder"
-  :action 'custom-tree-group-tag-action)
-
-(defun custom-tree-group-tag-action (widget &rest ignore)
+  :action 'custom-browse-group-tag-action)
+
+(defun custom-browse-group-tag-action (widget &rest ignore)
   (let ((parent (widget-get widget :parent)))
     (customize-group-other-window (widget-value parent))))
 
-(define-widget 'custom-tree-variable-tag 'push-button
+(define-widget 'custom-browse-variable-tag 'push-button
   "Show parent in other window when activated."
   :tag "Option"
   :tag-glyph "option"
-  :action 'custom-tree-variable-tag-action)
-
-(defun custom-tree-variable-tag-action (widget &rest ignore)
+  :action 'custom-browse-variable-tag-action)
+
+(defun custom-browse-variable-tag-action (widget &rest ignore)
   (let ((parent (widget-get widget :parent)))
     (customize-variable-other-window (widget-value parent))))
 
-(define-widget 'custom-tree-face-tag 'push-button
+(define-widget 'custom-browse-face-tag 'push-button
   "Show parent in other window when activated."
   :tag "Face"
   :tag-glyph "face"
-  :action 'custom-tree-face-tag-action)
-
-(defun custom-tree-face-tag-action (widget &rest ignore)
+  :action 'custom-browse-face-tag-action)
+
+(defun custom-browse-face-tag-action (widget &rest ignore)
   (let ((parent (widget-get widget :parent)))
     (customize-face-other-window (widget-value parent))))
 
-(defconst custom-tree-alist '(("   " "space")
+(defconst custom-browse-alist '(("   " "space")
 			      (" | " "vertical")
 			      ("-\\ " "top")
 			      (" |-" "middle")
 			      (" `-" "bottom")))
 
-(defun custom-tree-insert-prefix (prefix)
+(defun custom-browse-insert-prefix (prefix)
   "Insert PREFIX.  On XEmacs convert it to line graphics."
   (if nil ; (string-match "XEmacs" emacs-version)
       (progn 
@@ -1181,7 +1196,7 @@
 	  (let ((entry (substring prefix 0 3)))
 	    (setq prefix (substring prefix 3))
 	    (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
-		  (name (nth 1 (assoc entry custom-tree-alist))))
+		  (name (nth 1 (assoc entry custom-browse-alist))))
 	      (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
 	      (overlay-put overlay 'start-open t)
 	      (overlay-put overlay 'end-open t)))))
@@ -1565,8 +1580,31 @@
   "Load all dependencies for WIDGET."
   (custom-load-symbol (widget-value widget)))
 
+(defun custom-unloaded-symbol-p (symbol)
+  "Return non-nil if the dependencies of SYMBOL has not yet been loaded."
+  (let ((found nil)
+	(loads (get symbol 'custom-loads))
+	load)
+    (while loads
+      (setq load (car loads)
+	    loads (cdr loads))
+      (cond ((symbolp load)
+	     (unless (featurep load)
+	       (setq found t)))
+	    ((assoc load load-history))
+	    ((assoc (locate-library load) load-history)
+	     (message nil))
+	    (t
+	     (setq found t))))
+    found))
+
+(defun custom-unloaded-widget-p (widget)
+  "Return non-nil if the dependencies of WIDGET has not yet been loaded."
+  (custom-unloaded-symbol-p (widget-value widget)))
+
 (defun custom-toggle-hide (widget)
   "Toggle visibility of WIDGET."
+  (custom-load-widget widget)
   (let ((state (widget-get widget :custom-state)))
     (cond ((memq state '(invalid modified))
 	   (error "There are unset changes"))
@@ -1621,7 +1659,13 @@
 	found)
     (insert (or initial-string "Parent groups:"))
     (mapatoms (lambda (symbol)
-		(let ((entry (assq name (get symbol 'custom-group))))
+		(let ((entry (assq name
+				   (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 
@@ -1717,7 +1761,7 @@
     (cond ((eq custom-buffer-style 'tree)
 	   (insert prefix (if last " `--- " " |--- "))
 	   (push (widget-create-child-and-convert
-		  widget 'custom-tree-variable-tag)
+		  widget 'custom-browse-variable-tag)
 		 buttons)
 	   (insert " " tag "\n")
 	   (widget-put widget :buttons buttons))
@@ -2151,7 +2195,7 @@
     (cond ((eq custom-buffer-style 'tree)
 	   (insert prefix (if is-last " `--- " " |--- "))
 	   (push (widget-create-child-and-convert
-		  widget 'custom-tree-face-tag)
+		  widget 'custom-browse-face-tag)
 		 buttons)
 	   (insert " " tag "\n")
 	   (widget-put widget :buttons buttons))
@@ -2504,54 +2548,56 @@
 	(tag (widget-get widget :tag))
 	(symbol (widget-value widget)))
     (cond ((and (eq custom-buffer-style 'tree)
-		(eq state 'hidden))
-	   (custom-tree-insert-prefix prefix)
+		(eq state 'hidden)
+		(or (get symbol 'custom-group)
+		    (custom-unloaded-widget-p widget)))
+	   (custom-browse-insert-prefix prefix)
 	   (push (widget-create-child-and-convert
-		  widget 'custom-tree-visibility 
+		  widget 'custom-browse-visibility 
 		  ;; :tag-glyph "plus"
-		  :tag "+")
+		  :tag (if (custom-unloaded-widget-p widget) "?" "+"))
 		 buttons)
 	   (insert "-- ")
 	   ;; (widget-glyph-insert nil "-- " "horizontal")
 	   (push (widget-create-child-and-convert
-		  widget 'custom-tree-group-tag)
+		  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))))
-	   (custom-tree-insert-prefix prefix)
+	   (custom-browse-insert-prefix prefix)
 	   (insert "[ ]-- ")
 	   ;; (widget-glyph-insert nil "[ ]" "empty")
 	   ;; (widget-glyph-insert nil "-- " "horizontal")
 	   (push (widget-create-child-and-convert 
-		  widget 'custom-tree-group-tag)
+		  widget 'custom-browse-group-tag)
 		 buttons)
 	   (insert " " tag "\n")
 	   (widget-put widget :buttons buttons))
 	  ((eq custom-buffer-style 'tree)
-	   (custom-tree-insert-prefix prefix)
+	   (custom-browse-insert-prefix prefix)
 	   (custom-load-widget widget)
 	   (if (zerop (length (get symbol 'custom-group)))
 	       (progn 
-		 (custom-tree-insert-prefix prefix)
+		 (custom-browse-insert-prefix prefix)
 		 (insert "[ ]-- ")
 		 ;; (widget-glyph-insert nil "[ ]" "empty")
 		 ;; (widget-glyph-insert nil "-- " "horizontal")
 		 (push (widget-create-child-and-convert 
-			widget 'custom-tree-group-tag)
+			widget 'custom-browse-group-tag)
 		       buttons)
 		 (insert " " tag "\n")
 		 (widget-put widget :buttons buttons))
 	     (push (widget-create-child-and-convert 
-		    widget 'custom-tree-visibility 
+		    widget 'custom-browse-visibility 
 		    ;; :tag-glyph "minus"
 		    :tag "-")
 		   buttons)
 	     (insert "-\\ ")
 	     ;; (widget-glyph-insert nil "-\\ " "top")
 	     (push (widget-create-child-and-convert 
-		    widget 'custom-tree-group-tag)
+		    widget 'custom-browse-group-tag)
 		   buttons)
 	     (insert " " tag "\n")
 	     (widget-put widget :buttons buttons)
@@ -2561,7 +2607,6 @@
 			      custom-browse-order-groups))
 		    (prefixes (widget-get widget :custom-prefixes))
 		    (custom-prefix-list (custom-prefix-add symbol prefixes))
-		    (length (length members))
 		    (extra-prefix (if (widget-get widget :custom-last)
 				      "   "
 				    " | "))
@@ -2570,17 +2615,18 @@
 	       (while members
 		 (setq entry (car members)
 		       members (cdr members))
-		 (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))
+		 (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)))
 	       (widget-put widget :children (reverse children)))
 	     (message "Creating group...done")))
 	  ;; Nested style.
@@ -2849,7 +2895,12 @@
 	(princ "\n"))
       (princ "(custom-set-variables")
       (mapatoms (lambda (symbol)
-		  (let ((value (get symbol 'saved-value))
+		  (let ((value (condition-case nil
+				   (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))
@@ -2892,7 +2943,12 @@
 	      (princ ")")
 	    (princ " t)"))))
       (mapatoms (lambda (symbol)
-		  (let ((value (get symbol 'saved-face)))
+		  (let ((value (condition-case nil
+				   (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)
@@ -2914,14 +2970,17 @@
   "Save all user options which have been set in this session."
   (interactive)
   (mapatoms (lambda (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)))))
+	      (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))))))
   ;; We really should update all custom buffers here.
   (custom-save-all))
 
@@ -2941,17 +3000,17 @@
 (unless (string-match "XEmacs" emacs-version)
   (defconst custom-help-menu
     '("Customize"
-      ["Update menu..." Custom-menu-update t]
-      ["Browse..." (customize-browse 'emacs) t]
+      ["Update menu" Custom-menu-update t]
+      ["Browse" (customize-browse 'emacs) t]
       ["Group..." customize-group t]
-      ["Variable..." customize-variable t]
+      ["Option..." customize-option t]
       ["Face..." customize-face t]
       ["Saved..." customize-saved t]
       ["Set..." customize-customized t]
-      ["--" custom-menu-sep t]
+      "--"
       ["Apropos..." customize-apropos t]
       ["Group apropos..." customize-apropos-groups t]
-      ["Variable apropos..." customize-apropos-options t]
+      ["Option apropos..." customize-apropos-options t]
       ["Face apropos..." customize-apropos-faces t])
     ;; This menu should be identical to the one defined in `menu-bar.el'. 
     "Customize menu")