Re: Another load path idea

[Neil Jerram <neil@ossau.uklinux.net>]

Neil Jerram <neil@ossau.uklinux.net> writes:

> OK, let's proceed with the minimal first step of supporting an
> optional config file,
> $sysconfdir/guile/${EFFECTIVE-VERSION}/load-path.scm, which just
> contains the load path (as a list of strings).
>
> If this file doesn't exist, behaviour is unchanged from what it is
> now.  If it does exist, it overrides the built-in load path.

Below is the patch that I propose for this.  Please let me know if you
have any comments.

I'd personally like to have this in 1.8.  Any objections?

    Neil

Index: libguile/init.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/init.c,v
retrieving revision 1.170
diff -u -u -r1.170 init.c
--- libguile/init.c	29 Jan 2006 19:09:52 -0000	1.170
+++ libguile/init.c	9 Feb 2006 20:18:47 -0000
@@ -526,8 +526,8 @@
   scm_init_ramap ();
   scm_init_unif ();
   scm_init_simpos ();
-  scm_init_load_path ();
   scm_init_standard_ports ();  /* Requires fports */
+  scm_init_load_path ();	/* Requires standard output port */
   scm_init_dynamic_linking ();
 #if SCM_ENABLE_ELISP
   scm_init_lang ();
Index: libguile/load.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/load.c,v
retrieving revision 1.88
diff -u -u -r1.88 load.c
--- libguile/load.c	29 Jan 2006 00:23:27 -0000	1.88
+++ libguile/load.c	9 Feb 2006 20:18:47 -0000
@@ -43,6 +43,8 @@
 #include "libguile/validate.h"
 #include "libguile/load.h"
 #include "libguile/fluids.h"
+#include "libguile/version.h"
+#include "libguile/posix.h"
 
 #include <sys/types.h>
 #include <sys/stat.h>
@@ -195,6 +197,59 @@
 }
 #undef FUNC_NAME
 
+static SCM
+read_load_path_config_file (void *data)
+{
+  SCM *load_path_config = (SCM *)data;
+  SCM port = scm_open_file (scm_string_append (*load_path_config),
+			    scm_from_locale_string ("r"));
+  SCM path = scm_read (port);
+  SCM elts;
+
+  scm_close_port (port);
+
+  if (scm_ilength (path) <= 0)
+    scm_misc_error ("scm_init_load_path",
+		    "load path is empty or not a proper list: ~S",
+		    scm_list_1 (path));
+
+  for (elts = path; !scm_is_null (elts); elts = SCM_CDR (elts))
+    if (!scm_is_string (SCM_CAR (elts)))
+      scm_misc_error ("scm_init_load_path",
+		      "load path contains something that isn't a string: ~S",
+		      scm_list_1 (SCM_CAR (elts)));
+
+  return path;
+}
+
+static SCM
+handle_load_path_config_exception (void *data, SCM key, SCM args)
+{
+  SCM *handler_data = (SCM *)data;
+
+  if (scm_is_eq (key, scm_system_error_key) &&
+      (scm_ilength (args) == 4) &&
+      (scm_to_int (SCM_CAR (SCM_CADDDR (args))) == ENOENT))
+    {
+      /* This error just means that the file we tried to read does not
+	 exist.  This is a normal case, so return normally with no
+	 message. */
+    }
+  else
+    {
+      /* For any other error we print a message and then exit. */
+      SCM port = scm_current_error_port ();
+      scm_puts ("ERROR: Reading load path configuration from ", port);
+      scm_display (scm_string_append (SCM_CAR (*handler_data)), port);
+      scm_puts (":\n", port);
+      scm_puts ("ERROR: ", port);
+      scm_simple_format (port, SCM_CADR (args), SCM_CADDR (args));
+      scm_newline (port);
+      exit (1);
+    }
+
+  return SCM_CDR (*handler_data);
+}
 
 /* Initialize the global variable %load-path, given the value of the
    SCM_SITE_DIR and SCM_LIBRARY_DIR preprocessor symbols and the
@@ -204,6 +259,7 @@
 {
   char *env;
   SCM path = SCM_EOL;
+  SCM load_path_config = SCM_EOL;
 
 #ifdef SCM_LIBRARY_DIR
   path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
@@ -211,6 +267,44 @@
 		     scm_from_locale_string (SCM_PKGDATA_DIR));
 #endif /* SCM_LIBRARY_DIR */
 
+  /* Allow this load path to be overridden by the contents of
+     $GUILE_CONF_DIR/load-path.scm, if GUILE_CONF_DIR is defined, or
+     by $sysconfdir/guile/$EFFECTIVE-VERSION/load-path.scm if
+     GUILE_CONF_DIR is not defined. */
+  env = getenv ("GUILE_CONF_DIR");
+  if (env)
+    load_path_config = scm_list_2 (scm_from_locale_string (env),
+				   scm_from_locale_string ("/load-path.scm"));
+#ifdef SCM_BUILD_INFO
+  else
+    {
+      struct { char *key; char *val; } info[] = SCM_BUILD_INFO;
+      int i;
+
+      for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
+	{
+	  if (!strcmp (info[i].key, "sysconfdir"))
+	    {
+	      load_path_config =
+		scm_list_4 (scm_from_locale_string (info[i].val),
+			    scm_from_locale_string ("/guile/"),
+			    scm_effective_version (),
+			    scm_from_locale_string ("/load-path.scm"));
+	      break;
+	    }
+	}
+    }     
+#endif
+  if (!scm_is_null (load_path_config))
+    {
+      SCM handler_data = scm_cons (load_path_config, path);
+      path = scm_internal_catch (SCM_BOOL_T,
+				 read_load_path_config_file,
+				 &load_path_config,
+				 handle_load_path_config_exception,
+				 &handler_data);
+    }
+
   env = getenv ("GUILE_LOAD_PATH");
   if (env)
     path = scm_parse_path (scm_from_locale_string (env), path);



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel