- (/noshow pathname previous-pathnames)
- (let ((link (unix-readlink pathname)))
- (/noshow link)
- ;; Unlike the old CMU CL code, we handle a broken symlink by
- ;; returning the link itself. That way, CL:TRUENAME on a
- ;; broken link returns the link itself, so that CL:DIRECTORY
- ;; can return broken links, so that even without
- ;; Unix-specific extensions to do interesting things with
- ;; them, at least Lisp programs can see them and, if
- ;; necessary, delete them. (This is handy e.g. when your
- ;; managed-by-Lisp directories are visited by Emacs, which
- ;; creates broken links as notes to itself.)
- (if (null link)
- (return pathname)
- (let ((new-pathname
- (unix-simplify-pathname
- (if (relative-unix-pathname? link)
- (let* ((dir-len (1+ (position #\/
- pathname
- :from-end t)))
- (dir (subseq pathname 0 dir-len)))
- (/noshow dir)
- (concatenate 'base-string dir link))
- link))))
- (if (unix-file-kind new-pathname)
- (setf pathname new-pathname)
- (return pathname)))))
- ;; To generalize the principle that even if portable Lisp code
- ;; can't do anything interesting with a broken symlink, at
- ;; least it should be able to see and delete it, when we
- ;; detect a cyclic link, we return the link itself. (So even
- ;; though portable Lisp code can't do anything interesting
- ;; with a cyclic link, at least it can see it and delete it.)
- (if (member pathname previous-pathnames :test #'string=)
- (return pathname)
- (push pathname previous-pathnames))))
+ (/noshow pathname previous-pathnames)
+ (let ((link (unix-readlink pathname)))
+ (/noshow link)
+ ;; Unlike the old CMU CL code, we handle a broken symlink by
+ ;; returning the link itself. That way, CL:TRUENAME on a
+ ;; broken link returns the link itself, so that CL:DIRECTORY
+ ;; can return broken links, so that even without
+ ;; Unix-specific extensions to do interesting things with
+ ;; them, at least Lisp programs can see them and, if
+ ;; necessary, delete them. (This is handy e.g. when your
+ ;; managed-by-Lisp directories are visited by Emacs, which
+ ;; creates broken links as notes to itself.)
+ (if (null link)
+ (return pathname)
+ (let ((new-pathname
+ (unix-simplify-pathname
+ (if (relative-unix-pathname? link)
+ (let* ((dir-len (1+ (position #\/
+ pathname
+ :from-end t)))
+ (dir (subseq pathname 0 dir-len)))
+ (/noshow dir)
+ (concatenate 'base-string dir link))
+ link))))
+ (if (unix-file-kind new-pathname)
+ (setf pathname new-pathname)
+ (return pathname)))))
+ ;; To generalize the principle that even if portable Lisp code
+ ;; can't do anything interesting with a broken symlink, at
+ ;; least it should be able to see and delete it, when we
+ ;; detect a cyclic link, we return the link itself. (So even
+ ;; though portable Lisp code can't do anything interesting
+ ;; with a cyclic link, at least it can see it and delete it.)
+ (if (member pathname previous-pathnames :test #'string=)
+ (return pathname)
+ (push pathname previous-pathnames))))