Changeset 13230 for trunk/abcl/src/org


Ignore:
Timestamp:
03/02/11 20:34:38 (10 years ago)
Author:
vvoutilainen
Message:

Fix ticket #136: ABCL should allow DIRECTORY listings that don't follow symlinks, and/or provide a function for deleting a directory tree.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Pathname.java

    r13105 r13230  
    14761476    private static class pf_list_directory extends Primitive {
    14771477        pf_list_directory() {
    1478             super("list-directory", PACKAGE_SYS, true, "directory");
     1478            super("list-directory", PACKAGE_SYS, true, "directory &optional (resolve-symlinks t)");
    14791479        }
    14801480        @Override
    14811481        public LispObject execute(LispObject arg) {
     1482            return execute(arg, T);
     1483        }
     1484        @Override
     1485        public LispObject execute(LispObject arg, LispObject arg2) {
    14821486            Pathname pathname = coerceToPathname(arg);
    14831487            if (pathname instanceof LogicalPathname) {
     
    15471551                                p = Utilities.getDirectoryPathname(file);
    15481552                            } else {
    1549                                 p = new Pathname(file.getCanonicalPath());
     1553                                if (arg2 != NIL) {
     1554                                    p = new Pathname(file.getCanonicalPath());
     1555                                } else {
     1556                                    p = new Pathname(file.getAbsolutePath());
     1557                                }
    15501558                            }
    15511559                            result = new Cons(p, result);
  • trunk/abcl/src/org/armedbear/lisp/directory.lisp

    r12985 r13230  
    4646
    4747(defun list-directories-with-wildcards (pathname
    48           &optional (wild-inferiors-found nil))
     48                                        wild-inferiors-found
     49                                        resolve-symlinks)
    4950  (let* ((directory (pathname-directory pathname))
    5051   (first-wild-inferior (and (not wild-inferiors-found)
     
    6061   (newpath (make-pathname :directory non-wild
    6162         :name nil :type nil :defaults pathname))
    62    (entries (list-directory newpath)))
     63   (entries (list-directory newpath resolve-symlinks)))
    6364    (if (not (or wild wild-inferiors-found))
    6465  entries
     
    8788          (make-pathname :directory directory
    8889             :defaults newpath)
    89           (or first-wild-inferior wild-inferiors-found))))))
     90          (or first-wild-inferior wild-inferiors-found)
     91                            resolve-symlinks)))))
    9092       entries))))))
    9193
    9294
    93 (defun directory (pathspec &key)
     95(defun directory (pathspec &key (resolve-symlinks t))
    9496  (let ((pathname (merge-pathnames pathspec)))
    9597    (when (logical-pathname-p pathname)
     
    105107                    (when device
    106108                      (setq namestring (concatenate 'string device ":" namestring)))))
    107                 (let ((entries (list-directories-with-wildcards namestring))
     109                (let ((entries (list-directories-with-wildcards
     110                                namestring nil resolve-symlinks))
    108111                      (matching-entries ()))
    109112                  (dolist (entry entries)
Note: See TracChangeset for help on using the changeset viewer.