mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-02-26 08:40:45 -08:00
Implemented LOAD-LOGICAL-PATHNAME-TRANSLATIONS. TRUENAME now merges the pathname with the current working directory.
This commit is contained in:
parent
710e6e2888
commit
a5af1f450c
5 changed files with 35 additions and 3 deletions
|
|
@ -1785,6 +1785,10 @@ ECL 0.9d
|
|||
the first list and the second to the second one. However, ECL
|
||||
would not respect this.
|
||||
|
||||
- TRUENAME now merges a pathname with the current working directory
|
||||
when it has no directory of its own. Thus (TRUENAME #P"") is
|
||||
equivalent to (SI:GETCWD).
|
||||
|
||||
* ANSI compatibility:
|
||||
|
||||
- No symbol is exported from the CL package other than those specificied in
|
||||
|
|
@ -1823,7 +1827,7 @@ ECL 0.9d
|
|||
class A and this class is renamed as B, the method still
|
||||
specializes on the same class.
|
||||
|
||||
- Implemented WILD-PATHNAME-P.
|
||||
- Implemented WILD-PATHNAME-P, and LOAD-LOGICAL-PATHNAME-TRANSLATIONS.
|
||||
|
||||
TODO:
|
||||
=====
|
||||
|
|
|
|||
|
|
@ -674,6 +674,8 @@ cl_object
|
|||
coerce_to_file_pathname(cl_object pathname)
|
||||
{
|
||||
pathname = coerce_to_physical_pathname(pathname);
|
||||
if (!Null(cl_wild_pathname_p(1, pathname)))
|
||||
cl_error(3, @'file-error', @':pathname', pathname);
|
||||
pathname = cl_merge_pathnames(1, pathname);
|
||||
#if !defined(cygwin) && !defined(mingw32)
|
||||
if (pathname->pathname.device != Cnil)
|
||||
|
|
|
|||
|
|
@ -503,6 +503,7 @@ cl_symbols[] = {
|
|||
{"LISTEN", CL_ORDINARY, cl_listen, -1, OBJNULL},
|
||||
{"LISTP", CL_ORDINARY, cl_listp, 1, OBJNULL},
|
||||
{"LOAD", CL_ORDINARY, cl_load, -1, OBJNULL},
|
||||
{"LOAD-LOGICAL-PATHNAME-TRANSLATIONS", CL_ORDINARY, NULL, -1, OBJNULL},
|
||||
{"LOAD-TIME-VALUE", CL_FORM, NULL, -1, OBJNULL},
|
||||
{"LOCALLY", CL_FORM, NULL, -1, OBJNULL},
|
||||
{"LOG", CL_ORDINARY, cl_log, -1, OBJNULL},
|
||||
|
|
|
|||
|
|
@ -151,7 +151,12 @@ si_follow_symlink(cl_object filename) {
|
|||
cl_object
|
||||
cl_truename(cl_object pathname)
|
||||
{
|
||||
cl_object previous, dir, directory, filename;
|
||||
cl_object dir, directory, filename;
|
||||
cl_object previous = current_dir();
|
||||
|
||||
pathname = coerce_to_file_pathname(pathname);
|
||||
if (pathname->pathname.directory == Cnil)
|
||||
pathname = merge_pathnames(previous, pathname, @':newest');
|
||||
|
||||
/* First we ensure that PATHNAME itself does not point to a symlink. */
|
||||
filename = si_follow_symlink(pathname);
|
||||
|
|
@ -166,7 +171,6 @@ cl_truename(cl_object pathname)
|
|||
* possible symlinks. To do so, we only have to change to the directory
|
||||
* which contains our file, and come back.
|
||||
*/
|
||||
previous = current_dir();
|
||||
CL_UNWIND_PROTECT_BEGIN {
|
||||
for (dir = filename->pathname.directory;
|
||||
!Null(dir);
|
||||
|
|
|
|||
|
|
@ -13,6 +13,27 @@
|
|||
(defun logical-pathname-translations (p) (si:pathname-translations p))
|
||||
(defsetf logical-pathname-translations si:pathname-translations)
|
||||
|
||||
(defun load-logical-pathname-translations (host)
|
||||
"Search for a logical pathname named host, if not already defined. If already
|
||||
defined no attempt to find or load a definition is attempted and NIL is
|
||||
returned. If host is not already defined, but definition is found and loaded
|
||||
successfully, T is returned, else error."
|
||||
(declare (type string host)
|
||||
(values (member t nil)))
|
||||
(let ((*autoload-translations* nil))
|
||||
(unless (or (string-equal host "sys")
|
||||
(find-logical-host host nil))
|
||||
(with-open-file (in-str (make-pathname :defaults "sys:"
|
||||
:name (string-downcase host)
|
||||
:type "translations"))
|
||||
(if *load-verbose*
|
||||
(format *error-output*
|
||||
";; Loading pathname translations from ~A~%"
|
||||
(namestring (truename in-str))))
|
||||
(setf (logical-pathname-translations host) (read in-str)))
|
||||
t)))
|
||||
|
||||
|
||||
(defmacro time (form)
|
||||
"Syntax: (time form)
|
||||
Evaluates FORM, outputs the realtime and runtime used for the evaluation to
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue