- (name (un-unspecific (pathname-name path)))
- (type (un-unspecific (pathname-type path)))
- (new-dir
- (cond ((and name type) (list (concatenate 'string name "." type)))
- (name (list name))
- (type (list type))
- (t nil))))
+ (name (un-unspecific (pathname-name path)))
+ (type (un-unspecific (pathname-type path)))
+ (new-dir
+ (cond ((and name type) (list (concatenate 'string name "." type)))
+ (name (list name))
+ (type (list type))
+ (t nil))))
- (make-pathname
- :directory (append (un-unspecific (pathname-directory path))
- new-dir)
- :name nil :type nil :version nil :defaults path)
- path))))
-
+ (make-pathname
+ :directory (append (un-unspecific (pathname-directory path))
+ new-dir)
+ :name nil :type nil :version nil :defaults path)
+ path))))
- (probe
- #+allegro (excl:probe-directory path)
- #+clisp (values
- (ignore-errors
- (#+lisp=cl ext:probe-directory
- #-lisp=cl lisp:probe-directory
- path)))
- #+(or cmu scl) (when (eq :directory
- (unix:unix-file-kind (namestring path)))
- path)
- #+lispworks (when (lw:file-directory-p path)
- path)
- #+sbcl (when (eq :directory
- (sb-unix:unix-file-kind (namestring path)))
- path)
- #-(or allegro clisp cmu lispworks sbcl scl)
- (probe-file path)))
+ (probe
+ #+allegro (excl:probe-directory path)
+ #+clisp (values
+ (ignore-errors
+ (#+lisp=cl ext:probe-directory
+ #-lisp=cl lisp:probe-directory
+ path)))
+ #+(or cmu scl) (when (eq :directory
+ (unix:unix-file-kind (namestring path)))
+ path)
+ #+lispworks (when (lw:file-directory-p path)
+ path)
+ #+sbcl (when (eq :directory
+ (sb-unix:unix-file-kind (namestring path)))
+ path)
+ #-(or allegro clisp cmu lispworks sbcl scl)
+ (probe-file path)))
(defun cwd (&optional dir)
"Change directory and set default pathname"
(cond
((not (null dir))
(when (and (typep dir 'logical-pathname)
(defun cwd (&optional dir)
"Change directory and set default pathname"
(cond
((not (null dir))
(when (and (typep dir 'logical-pathname)
- #+allegro (excl:current-directory)
- #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
- #+(or cmu scl) (ext:default-directory)
- #+sbcl (sb-unix:posix-getcwd/)
- #+cormanlisp (ccl:get-current-directory)
- #+lispworks (hcl:get-working-directory)
- #+mcl (ccl:mac-default-directory)
- #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
+ #+allegro (excl:current-directory)
+ #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
+ #+(or cmu scl) (ext:default-directory)
+ #+sbcl (sb-unix:posix-getcwd/)
+ #+cormanlisp (ccl:get-current-directory)
+ #+lispworks (hcl:get-working-directory)
+ #+mcl (ccl:mac-default-directory)
+ #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
- :preserve-symbolic-links preserve-symbolic-links
- :preserve-time preserve-time
- :remove-destination remove-destination
- :force force :verbose verbose)
+ :preserve-symbolic-links preserve-symbolic-links
+ :preserve-time preserve-time
+ :remove-destination remove-destination
+ :force force :verbose verbose)
(run-shell-command "ln -f ~A ~A" (namestring from) (namestring to)))
(link
(multiple-value-bind (stdout stderr status)
(run-shell-command "ln -f ~A ~A" (namestring from) (namestring to)))
(link
(multiple-value-bind (stdout stderr status)
- (let* ((options (if preserve-time
- "-p"
- ""))
- (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))
+ (let* ((options (if preserve-time
+ "-p"
+ ""))
+ (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))