diff lisp/cus-edit.el @ 2544:b4a8cd0dd8df

[xemacs-hg @ 2005-02-03 04:29:32 by ben] behavior ws #1: custom updates cus-dep.el: If a directory has no custom dependencies, write a blank custom-load file rather than deleting the file, so that time-based rebuild checking will work. cus-edit.el: Split out code in custom-load-symbol. Support loading of the new custom-defines file. cus-edit.el: Split long menus. custom.el: Sync with FSF 21.3.
author ben
date Thu, 03 Feb 2005 04:29:33 +0000
parents 3c70cbcc7ae8
children cef5f57bb9e2
line wrap: on
line diff
--- a/lisp/cus-edit.el	Wed Feb 02 22:51:40 2005 +0000
+++ b/lisp/cus-edit.el	Thu Feb 03 04:29:33 2005 +0000
@@ -1,6 +1,7 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2003 Ben Wing.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
@@ -1656,23 +1657,121 @@
       (while loads
 	(setq load (car loads)
 	      loads (cdr loads))
-	(cond ((symbolp load)
-	       (condition-case nil
-		   (require load)
-		 (error nil)))
-	      ;; Don't reload a file already loaded.
-	      ((and (boundp 'preloaded-file-list)
-		    (member load preloaded-file-list)))
-	      ((assoc load load-history))
-	      ((assoc (locate-library load) load-history))
-	      (t
-	       (condition-case nil
-		   ;; 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))))))))
+	(custom-load-symbol-1 load)))))
+
+(defun custom-load-symbol-1 (load)
+  (cond ((symbolp load)
+	 (condition-case nil
+	     (require load)
+	   (error nil)))
+	;; Don't reload a file already loaded.
+	((and (boundp 'preloaded-file-list)
+	      (member load preloaded-file-list)))
+	((assoc load load-history))
+	((assoc (locate-library load) load-history))
+	(t
+	 (condition-case nil
+	     ;; 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)))))
+
+(defvar custom-already-loaded-custom-defines nil
+  "List of already-loaded `custom-defines' files.")
+(defvar custom-define-current-source-file nil)
+(defvar custom-warn-when-reloading-necessary nil
+  "For package-debugging purposes: Warn when an error hit in custom-defines.el.
+When this happens, the file from which the defcustom or defgroup was taken
+is loaded, and custom-defines.el is then reloaded.  This works in most
+cases, but may not be completely safe.  It's better if the package itself
+arranges for the necessary functions and variables to be available, using
+\;;;###autoload declarations.  When this variable is non-nil, warnings are
+issued (with backtrace), to aid in tracking down the problems.")
+
+(defun custom-load-custom-defines (symbol)
+  "Load custom-defines for SYMBOL."
+  (unless custom-load-recursion
+    (let ((custom-load-recursion t)
+	  (loads (get symbol 'custom-loads))
+	  load)
+      (while loads
+	(setq load (car loads)
+	      loads (cdr loads))
+	(let* ((found (locate-library
+		       (if (symbolp load) (symbol-name load) load)))
+	       (dir (and found (file-name-directory found))))
+	  ;; If we find a custom-defines file, assume the package is smart
+	  ;; enough to have put all its defcustoms and defgroups here, and
+	  ;; load it instead of the file itself.  Otherwise, do it the
+	  ;; hard way.
+	  (if (and found (or (file-exists-p
+			      (expand-file-name "custom-defines.elc" dir))
+			     (file-exists-p
+			      (expand-file-name "custom-defines.el" dir))))
+	      (when (not (member dir custom-already-loaded-custom-defines))
+		(push dir custom-already-loaded-custom-defines)
+		(custom-load-custom-defines-1 dir))))))))
+
+(defun custom-load-custom-defines-1 (dir)
+  ;; Actually load the custom-defines.el file in DIR.
+
+  ;; If we get an error loading the custom-defines, it may be because of a
+  ;; reference to something (e.g. a constant) that hasn't yet been defined
+  ;; yet.  Properly, these should have been marked, so they either go into
+  ;; the custom-defines.el file or are autoloaded.  But not everyone is so
+  ;; careful, so for the moment we try to load the file that the
+  ;; error-generating defcustom came from, and then reload the
+  ;; custom-defines.el file.  We might loop a number of times if we have
+  ;; various files that need loading.  If at any point we get an error that
+  ;; can't be solved just by loading the appropriate file (e.g. we hit the
+  ;; same error as before, the file is already loaded, etc.) then we signal
+  ;; it as a real error.
+  (let (source)
+    ;; here's how this works: if we get an error loading custom-defines,
+    ;; the condition handler is called; if we need to reload, we
+    ;; `return-from', which throws out of the handler and returns nil from
+    ;; the `block', which continues the while statement, executing the
+    ;; `load' at the bottom of this function and then entering the block
+    ;; again.  if the condition handler doesn't throw, but instead returns
+    ;; normally, `signal' will continue as if nothing happened, and end up
+    ;; signalling the error normally.
+    (while
+	(not
+	 (block custom-load
+	   ;; Use call-with-condition-handler so the error can be seen
+	   ;; with the stack intact.
+	   (call-with-condition-handler
+	       #'(lambda (__custom_load_cd1__)
+		   (when (and
+			  custom-define-current-source-file
+			  (progn
+			    (setq source (expand-file-name
+					  custom-define-current-source-file
+					  dir))
+			    (let ((nondir (file-name-nondirectory source)))
+			      (and (file-exists-p source)
+				   (not (assoc source load-history))
+				   (not (assoc nondir load-history))
+				   (not (and (boundp 'preloaded-file-list)
+					     (member nondir
+						     preloaded-file-list)))))))
+		     (if custom-warn-when-reloading-necessary
+			 (lwarn 'custom-defines 'warning
+			   "Error while loading custom-defines, fetching source and reloading ...\n
+Error: %s\n
+Source file: %s\n\n
+Backtrace follows:\n\n%s"
+			   (error-message-string __custom_load_cd1__)
+			   source
+			   (backtrace-in-condition-handler-eliminating-handler
+			    '__custom_load_cd1__)))
+		     (return-from custom-load nil)))
+	       #'(lambda ()
+		   (load (expand-file-name "custom-defines" dir))))))
+      ;; we get here only from the `return-from'; see above 
+      (load source))))
 
 (defun custom-load-widget (widget)
   "Load all dependencies for WIDGET."
@@ -3709,31 +3808,33 @@
 (defun custom-menu-create (symbol)
   "Create menu for customization group SYMBOL.
 The menu is in a format applicable to `easy-menu-define'."
-  (let* ((item (vector (custom-unlispify-menu-entry symbol)
-		       `(customize-group ',symbol)
-		       t)))
-    ;; Item is the entry for creating a menu buffer for SYMBOL.
-    ;; We may nest, if the menu is not too big.
-    (custom-load-symbol symbol)
-    (if (< (length (get symbol 'custom-group)) widget-menu-max-size)
-	;; The menu is not too big.
-	(let ((custom-prefix-list (custom-prefix-add symbol
-						     custom-prefix-list))
-	      (members (custom-sort-items (get symbol 'custom-group)
-					  custom-menu-sort-alphabetically
-					  custom-menu-order-groups)))
-	  ;; Create the menu.
-	  `(,(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)))
-		      members)))
-      ;; The menu was too big.
-      item)))
+  (menu-split-long-menu
+   (let* ((item (vector (custom-unlispify-menu-entry symbol)
+			`(customize-group ',symbol)
+			t)))
+     ;; Item is the entry for creating a menu buffer for SYMBOL.
+     ;; We may nest, if the menu is not too big.
+     (custom-load-custom-defines symbol)
+     (if t ;(< (length (get symbol 'custom-group)) widget-menu-max-size)
+	 ;; The menu is not too big.
+	 (let ((custom-prefix-list (custom-prefix-add symbol
+						      custom-prefix-list))
+	       (members (custom-sort-items (get symbol 'custom-group)
+					   custom-menu-sort-alphabetically
+					   custom-menu-order-groups)))
+	   ;; Create the menu.
+	   `(,(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)))
+		       members)))
+       ; else ;; The menu was too big.
+       item
+       ))))
 
 ;;;###autoload
 (defun customize-menu-create (symbol &optional name)