[PATCH] v2: Fix ')cd' for SBCL on Windows

[Qian Yun]

Opening a new thread. Now this patch reflects the common
agreement on previous thread.

Now this patch fixes ")cd" for sbcl on windows,
while preserving the side effects of modifying
*default-pathname-defaults.

- Qian

[Waldek Hebisch]

Thanks, please commit.

> diff --git a/src/lisp/fricas-lisp.lisp b/src/lisp/fricas-lisp.lisp
> index 1bb843e6..0a671b7f 100644
> --- a/src/lisp/fricas-lisp.lisp
> +++ b/src/lisp/fricas-lisp.lisp
> @@ -256,16 +256,9 @@ with this hack and will try to convince the GCL crowd to fix this.
> (t nil))))
>
> #+:sbcl
> -(eval-when (:execute :compile-toplevel :load-toplevel)
> - (require :sb-posix))
> -#+:sbcl
> (defun CHDIR (dir)
> - (let ((tdir (probe-file dir)))
> - (cond
> - (tdir
> - #-:win32 (sb-posix::chdir tdir)
> - (setq *default-pathname-defaults* tdir))
> - (t nil))))
> + (sb-posix:chdir dir)
> + (setq *default-pathname-defaults* (pathname (|get_current_directory|))))
>
> #+(and :clisp (or :unix :win32))
> (defun CHDIR (dir)
> @@ -823,10 +816,14 @@ with this hack and will try to convince the GCL crowd to fix this.
> (multiple-value-bind (win dir) (unix::unix-current-directory)
> (declare (ignore win)) dir))
>
> -#+(or :ecl :GCL :sbcl :clisp :openmcl :abcl)
> +#+(or :ecl :GCL :clisp :openmcl :abcl)
> (defun |get_current_directory| ()
> (|trim_directory_name| (namestring (truename ""))))
>
> +#+:sbcl
> +(defun |get_current_directory| ()
> + (sb-unix:posix-getcwd))
> +
> #+:poplog
> (defun |get_current_directory| ()
> (let ((name (namestring (truename "."))))
> diff --git a/src/lisp/fricas-package.lisp b/src/lisp/fricas-package.lisp
> index f6c2d25e..132a9ac7 100644
> --- a/src/lisp/fricas-package.lisp
> +++ b/src/lisp/fricas-package.lisp
> @@ -4,6 +4,7 @@
> "LISP")))
> #+:sbcl
> (eval-when (:execute :compile-toplevel :load-toplevel)
> + (require :sb-posix)
> (ignore-errors (require "SB-SPROF")))
>
> #+:cmu


--
Waldek Hebisch