/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008,
- * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#include <sys/types.h>
#include <sys/stat.h>
-
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif /* HAVE_UNISTD_H */
#ifdef HAVE_PWD_H
#include <pwd.h>
{
SCM hook = *scm_loc_load_hook;
SCM ret = SCM_UNSPECIFIED;
- char *encoding;
SCM_VALIDATE_STRING (1, filename);
if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
{
SCM port;
- port = scm_open_file (filename, scm_from_locale_string ("r"));
+ port = scm_open_file_with_encoding (filename,
+ scm_from_latin1_string ("r"),
+ SCM_BOOL_T, /* guess_encoding */
+ scm_from_latin1_string ("UTF-8"));
+
scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
scm_i_dynwind_current_load_port (port);
- /* FIXME: For better or for worse, scm_open_file already scans the
- file for an encoding. This scans again; necessary for this
- logic, but unnecessary overall. */
- encoding = scm_i_scan_for_encoding (port);
- if (encoding)
- scm_i_set_port_encoding_x (port, encoding);
- else
- /* The file has no encoding declared. We'll presume UTF-8, like
- compile-file does. */
- scm_i_set_port_encoding_x (port, "UTF-8");
-
while (1)
{
SCM reader, form;
#undef FUNC_NAME
#endif /* SCM_GLOBAL_SITE_DIR */
+#ifdef SCM_SITE_CCACHE_DIR
+SCM_DEFINE (scm_sys_site_ccache_dir, "%site-ccache-dir", 0,0,0,
+ (),
+ "Return the directory where users should install compiled\n"
+ "@code{.go} files for use with this version of Guile.\n\n"
+ "E.g., may return \"/usr/lib/guile/" SCM_EFFECTIVE_VERSION "/site-ccache\".")
+#define FUNC_NAME s_scm_sys_site_ccache_dir
+{
+ return scm_from_locale_string (SCM_SITE_CCACHE_DIR);
+}
+#undef FUNC_NAME
+#endif /* SCM_SITE_CCACHE_DIR */
+
\f
/* Initializing the load path, and searching it. */
return 0;
}
+#ifdef __MINGW32__
+#define FILE_NAME_SEPARATOR_STRING "\\"
+#else
+#define FILE_NAME_SEPARATOR_STRING "/"
+#endif
+
+static int
+is_file_name_separator (SCM c)
+{
+ if (scm_is_eq (c, SCM_MAKE_CHAR ('/')))
+ return 1;
+#ifdef __MINGW32__
+ if (scm_is_eq (c, SCM_MAKE_CHAR ('\\')))
+ return 1;
+#endif
+ return 0;
+}
+
+static int
+is_drive_letter (SCM c)
+{
+#ifdef __MINGW32__
+ if (SCM_CHAR (c) >= 'a' && SCM_CHAR (c) <= 'z')
+ return 1;
+ else if (SCM_CHAR (c) >= 'A' && SCM_CHAR (c) <= 'Z')
+ return 1;
+#endif
+ return 0;
+}
+
+static int
+is_absolute_file_name (SCM filename)
+{
+ size_t filename_len = scm_c_string_length (filename);
+
+ if (filename_len >= 1
+ && is_file_name_separator (scm_c_string_ref (filename, 0))
+#ifdef __MINGW32__
+ /* On Windows, one initial separator indicates a drive-relative
+ path. Two separators indicate a Universal Naming Convention
+ (UNC) path. UNC paths are always absolute. */
+ && filename_len >= 2
+ && is_file_name_separator (scm_c_string_ref (filename, 1))
+#endif
+ )
+ return 1;
+ if (filename_len >= 3
+ && is_drive_letter (scm_c_string_ref (filename, 0))
+ && scm_is_eq (scm_c_string_ref (filename, 1), SCM_MAKE_CHAR (':'))
+ && is_file_name_separator (scm_c_string_ref (filename, 2)))
+ return 1;
+ return 0;
+}
+
/* Search PATH for a directory containing a file named FILENAME.
The file must be readable, and not a directory.
If we find one, return its full pathname; otherwise, return #f.
scm_dynwind_free (filename_chars);
/* If FILENAME is absolute and is still valid, return it unchanged. */
-#ifdef __MINGW32__
- if (((filename_len >= 1) &&
- (filename_chars[0] == '/' || filename_chars[0] == '\\')) ||
- ((filename_len >= 3) && filename_chars[1] == ':' &&
- ((filename_chars[0] >= 'a' && filename_chars[0] <= 'z') ||
- (filename_chars[0] >= 'A' && filename_chars[0] <= 'Z')) &&
- (filename_chars[2] == '/' || filename_chars[2] == '\\')))
-#else
- if (filename_len >= 1 && filename_chars[0] == '/')
-#endif
+ if (is_absolute_file_name (filename))
{
if ((scm_is_false (require_exts) ||
scm_c_string_has_an_ext (filename_chars, filename_len,
extensions = SCM_EOL;
break;
}
-#ifdef __MINGW32__
- else if (*endp == '/' || *endp == '\\')
-#else
- else if (*endp == '/')
-#endif
+ else if (is_file_name_separator (SCM_MAKE_CHAR (*endp)))
/* This filename has no extension, so keep the current list
of extensions. */
break;
/* Concatenate the path name and the filename. */
-#ifdef __MINGW32__
- if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/') && (buf.ptr[-1] != '\\'))
-#else
- if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/'))
-#endif
- stringbuf_cat (&buf, "/");
+ if (buf.ptr > buf.buf
+ && !is_file_name_separator (SCM_MAKE_CHAR (buf.ptr[-1])))
+ stringbuf_cat (&buf, FILE_NAME_SEPARATOR_STRING);
stringbuf_cat (&buf, filename_chars);
sans_ext_len = buf.ptr - buf.buf;
NULL, NULL);
}
-/* See also (system base compile):compiled-file-name. */
+/* The auto-compilation code will residualize a .go file in the cache
+ dir: by default, $HOME/.cache/guile/2.0/ccache/PATH.go. This
+ function determines the PATH to use as a key into the compilation
+ cache. See also (system base compile):compiled-file-name. */
static SCM
canonical_suffix (SCM fname)
{
SCM canon;
- size_t len;
+ /* CANON should be absolute. */
canon = scm_canonicalize_path (fname);
- len = scm_c_string_length (canon);
- if (len > 1 && scm_is_eq (scm_c_string_ref (canon, 0), SCM_MAKE_CHAR ('/')))
- return canon;
- else if (len > 2 && scm_is_eq (scm_c_string_ref (canon, 1), SCM_MAKE_CHAR (':')))
- return scm_string_append (scm_list_3 (scm_from_latin1_string ("/"),
- scm_c_substring (canon, 0, 1),
- scm_c_substring (canon, 2, len)));
- else
- return canon;
+#ifdef __MINGW32__
+ {
+ size_t len = scm_c_string_length (canon);
+
+ /* On Windows, an absolute file name that doesn't start with a
+ separator starts with a drive component. Transform the drive
+ component to a file name element: c:\foo -> \c\foo. */
+ if (len >= 2
+ && is_absolute_file_name (canon)
+ && !is_file_name_separator (scm_c_string_ref (canon, 0)))
+ return scm_string_append
+ (scm_list_3 (scm_from_latin1_string (FILE_NAME_SEPARATOR_STRING),
+ scm_c_substring (canon, 0, 1),
+ scm_c_substring (canon, 2, len)));
+ }
+#endif
+
+ return canon;
}
SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
HCoop / bpt / guile.git / blobdiff