anchor.diff:                               path nil))))
   
   
  -(DEFUN CHANGE-WORKING-DIRECTORY (PATH)
  +(defun change-working-directory (path)
     (multiple-value-bind (exists-p dirpath) (check-directories-exist path)
       (if exists-p
           (progn
             ;; (print (list path dirpath (truename dirpath)))
  -          (SETF *WORKING-DIRECTORY* (truename dirpath))
  -          (DOLIST (HOOK *CHANGE-DIRECTORY-HOOK*)
  -            (LET ((*WORKING-DIRECTORY* *WORKING-DIRECTORY*))
  -              (FUNCALL HOOK *WORKING-DIRECTORY*))))
  +          (setf *working-directory* (truename dirpath))
  +          (dolist (hook *change-directory-hook*)
  +            (let ((*working-directory* *working-directory*))
  +              (funcall hook *working-directory*))))
           (error "nonexistent directory: ~S" dirpath)))
  -  *WORKING-DIRECTORY*)
  +  *working-directory*)
   
   
     
  -(DEFUN PARENT-DIRECTORY (DIRPATH)
  -  (MAKE-PATHNAME :DIRECTORY (LET ((DIR (PATHNAME-DIRECTORY DIRPATH)))
  -                              (CONS (CAR DIR) (BUTLAST (CDR DIR))))
  +(defun parent-directory (dirpath)
  +  (make-pathname :directory (let ((dir (pathname-directory dirpath)))
  +                              (cons (car dir) (butlast (cdr dir))))
                    :defaults dirpath))
   
   
  -(DEFUN SUBDIRECTORIES (DIRPATH)
  -  (DIRECTORY
  -   (merge-pathnames (MAKE-PATHNAME :DIRECTORY '(:RELATIVE :WILD)) DIRPATH)))
  -
  -
  -(DEFUN FILTER-OUT-DOTS (LIST)
  -  (DELETE-IF
  -   (LAMBDA (PATH)
  -     (CHAR= (CHARACTER ".")
  -            (AREF (OR (PATHNAME-NAME PATH)
  -                      (CAR (LAST (PATHNAME-DIRECTORY PATH)))) 0)))
  -   LIST))
  -
  -
  -(DEFUN SUBDIRECTORIES-NAMES (DIRPATH &KEY (KEEP-DOT-FILES *KEEP-DOT-FILES*))
  -  (LET ((SUBS (SUBDIRECTORIES DIRPATH)))
  -    (UNLESS KEEP-DOT-FILES  (SETF SUBS (FILTER-OUT-DOTS SUBS)))
  -    (MAPCAR (LAMBDA (PATH) (CAR (LAST (PATHNAME-DIRECTORY PATH)))) SUBS)))
  -
  -
  -(DEFUN CHILD-DIRECTORY (DIRPATH CHILD)
  -  (MERGE-PATHNAMES (MAKE-PATHNAME :DIRECTORY (LIST :RELATIVE CHILD)) DIRPATH))
  -
  -
  -(DEFUN FILES (DIRPATH &KEY (TYPE :WILD) (KEEP-DOT-FILES *KEEP-DOT-FILES*))
  -  (LET ((FILES (DIRECTORY
  -                (MAKE-PATHNAME :NAME :WILD :TYPE TYPE :defaults DIRPATH))))
  -    (UNLESS KEEP-DOT-FILES (SETF FILES (FILTER-OUT-DOTS FILES)))
  -    (MAPCAR (LAMBDA (PATH) (CONS (PATHNAME-NAME PATH) PATH)) FILES)))
  -
  -
  -(DEFPARAMETER *SCREEN-WIDTH* 80)
  -
  -(DEFUN PRINT-LIST (STREAM LIST OFFSET &KEY (INDEX-WIDTH 2))
  -  (LET* ((ITEM-WIDTH (REDUCE (FUNCTION MAX) LIST :KEY (FUNCTION LENGTH)))
  -         (MAX-WIDTH (+ INDEX-WIDTH 3 ITEM-WIDTH))
  -         (COL-COUNT (TRUNCATE *SCREEN-WIDTH* MAX-WIDTH))
  -         (ROW-COUNT (TRUNCATE (+ (LENGTH LIST) COL-COUNT -1) COL-COUNT))
  -         (TABLE (MAKE-ARRAY (LIST COL-COUNT ROW-COUNT) :INITIAL-ELEMENT ""))
  -         (X 0) (Y 0))
  -    (DOLIST (ITEM LIST)
  -      (SETF (AREF TABLE X Y)
  -            (FORMAT NIL "~V,D) ~V,A" INDEX-WIDTH OFFSET ITEM-WIDTH ITEM))
  -      (INCF OFFSET)
  -      (INCF Y)
  -      (IF (<= ROW-COUNT Y)
  -          (SETF X (1+ X) Y 0)))
  -    (DOTIMES (Y ROW-COUNT)
  -      (DOTIMES (X (1- COL-COUNT))
  -        (PRINC (AREF TABLE X Y) STREAM)
  -        (PRINC " " STREAM))
  -      (PRINC (AREF TABLE (1- COL-COUNT) Y) STREAM)
  -      (TERPRI STREAM))))
  -
  -
  -(DEFUN BROWSE ()
  +(defun subdirectories (dirpath)
  +  (directory
  +   (merge-pathnames (make-pathname :directory '(:relative :wild)) dirpath)))
  +
  +
  +(defun filter-out-dots (list)
  +  (delete-if
  +   (lambda (path)
  +     (char= (character ".")
  +            (aref (or (pathname-name path)
  +                      (car (last (pathname-directory path)))) 0)))
  +   list))
  +
  +
  +(defun subdirectories-names (dirpath &key (keep-dot-files *keep-dot-files*))
  +  (let ((subs (subdirectories dirpath)))
  +    (unless keep-dot-files  (setf subs (filter-out-dots subs)))
  +    (mapcar (lambda (path) (car (last (pathname-directory path)))) subs)))
  +
  +
  +(defun child-directory (dirpath child)
  +  (merge-pathnames (make-pathname :directory (list :relative child)) dirpath))
  +
  +
  +(defun files (dirpath &key (type :wild) (keep-dot-files *keep-dot-files*))
  +  (let ((files (directory
  +                (make-pathname :name :wild :type type :defaults dirpath))))
  +    (unless keep-dot-files (setf files (filter-out-dots files)))
  +    (mapcar (lambda (path) (cons (pathname-name path) path)) files)))
  +
  +
  +(defparameter *screen-width* 80)
  +
  +(defun print-list (stream list offset &key (index-width 2))
  +  (let* ((item-width (reduce (function max) list :key (function length)))
  +         (max-width (+ index-width 3 item-width))
  +         (col-count (truncate *screen-width* max-width))
  +         (row-count (truncate (+ (length list) col-count -1) col-count))
  +         (table (make-array (list col-count row-count) :initial-element ""))
  +         (x 0) (y 0))
  +    (dolist (item list)
  +      (setf (aref table x y)
  +            (format nil "~V,D) ~V,A" index-width offset item-width item))
  +      (incf offset)
  +      (incf y)
  +      (if (<= row-count y)
  +          (setf x (1+ x) y 0)))
  +    (dotimes (y row-count)
  +      (dotimes (x (1- col-count))
  +        (princ (aref table x y) stream)
  +        (princ " " stream))
  +      (princ (aref table (1- col-count) y) stream)
  +      (terpri stream))))
  +
  +
  +(defun browse ()
     "COMMAND
   DO:         Displays the contents of the working directory and
               allows the user to navigate in the directory tree and
               to load files.
   "
  -  (LOOP
  -     (LET* ((SUBDIRS     (SORT (SUBDIRECTORIES-NAMES (WORKING-DIRECTORY))
  -                               (FUNCTION STRING<)))
  -            (FILES       (SORT (FILES (WORKING-DIRECTORY) :TYPE "lisp")
  -                               (LAMBDA (A B) (STRING< (CAR A) (CAR B)))))
  -            (ITEM-COUNT  (+ (LENGTH SUBDIRS) (LENGTH FILES)))
  -            (COUNT-WIDTH (if (= 0 item-count) 1 (CEILING (LOG ITEM-COUNT 10)))))
  -       (FORMAT T "~&")
  -       (FORMAT T "--- current directory ----------------------------~%")
  -       (FORMAT T "~V,A  ~A~%" COUNT-WIDTH "" (WORKING-DIRECTORY))
  -       (FORMAT T "--- parent directory ----------------------------~%")
  -       (FORMAT T "~V,D) ~A~%"
  -               COUNT-WIDTH 0 (PARENT-DIRECTORY (WORKING-DIRECTORY)))
  -       (WHEN SUBDIRS
  -         (FORMAT T "--- subdirectories -------------------------------~%")
  -         (PRINT-LIST T SUBDIRS 1 :INDEX-WIDTH COUNT-WIDTH))
  -       (WHEN FILES
  -         (FORMAT T "--- files ----------------------------------------~%")
  -         (PRINT-LIST T (MAPCAR (FUNCTION CAR) FILES)
  -                     (1+ (LENGTH SUBDIRS)) :INDEX-WIDTH COUNT-WIDTH))
  -       (FORMAT T "--------------------------------------------------~%")
  -       (LET ((ANSWER
  -              (BLOCK :ANSWER
  -                (LOOP
  -                   (FORMAT T "~&Change directory number, ~
  +  (loop
  +     (let* ((subdirs     (sort (subdirectories-names (working-directory))
  +                               (function string<)))
  +            (files       (sort (files (working-directory) :type "lisp")
  +                               (lambda (a b) (string< (car a) (car b)))))
  +            (item-count  (+ (length subdirs) (length files)))
  +            (count-width (if (= 0 item-count) 1 (ceiling (log item-count 10)))))
  +       (format t "~&")
  +       (format t "--- current directory ----------------------------~%")
  +       (format t "~V,A  ~A~%" count-width "" (working-directory))
  +       (format t "--- parent directory ----------------------------~%")
  +       (format t "~V,D) ~A~%"
  +               count-width 0 (parent-directory (working-directory)))
  +       (when subdirs
  +         (format t "--- subdirectories -------------------------------~%")
  +         (print-list t subdirs 1 :index-width count-width))
  +       (when files
  +         (format t "--- files ----------------------------------------~%")
  +         (print-list t (mapcar (function car) files)
  +                     (1+ (length subdirs)) :index-width count-width))
  +       (format t "--------------------------------------------------~%")
  +       (let ((answer
  +              (block :answer
  +                (loop
  +                   (format t "~&Change directory number, ~
                               load file number, or -1 to quit: ")
  -                   (FINISH-OUTPUT)
  -                   (LET ((ANSWER (READ T NIL NIL)))
  -                     (TYPECASE ANSWER
  -                       (INTEGER (IF (<= -1 ANSWER ITEM-COUNT)
  -                                    (RETURN-FROM :ANSWER ANSWER)
  -                                    (FORMAT T "~&Input out of range.~%")))
  -                       (OTHERWISE (FORMAT T "~&Bad input type.~%"))))))))
  -         (COND
  -           ((= -1 ANSWER) (RETURN))
  -           ((= 0 ANSWER)
  -            (CHANGE-WORKING-DIRECTORY (PARENT-DIRECTORY (WORKING-DIRECTORY))))
  -           ((<= ANSWER (LENGTH SUBDIRS))
  -            (CHANGE-WORKING-DIRECTORY 
  -             (CHILD-DIRECTORY (WORKING-DIRECTORY) (ELT SUBDIRS (1- ANSWER)))))
  -           (T (LOAD (CDR (ELT FILES (- ANSWER (LENGTH SUBDIRS) 1)))
  -                    :VERBOSE T)))))))
  +                   (finish-output)
  +                   (let ((answer (read t nil nil)))
  +                     (typecase answer
  +                       (integer (if (<= -1 answer item-count)
  +                                    (return-from :answer answer)
  +                                    (format t "~&Input out of range.~%")))
  +                       (otherwise (format t "~&Bad input type.~%"))))))))
  +         (cond
  +           ((= -1 answer) (return))
  +           ((= 0 answer)
  +            (change-working-directory (parent-directory (working-directory))))
  +           ((<= answer (length subdirs))
  +            (change-working-directory 
  +             (child-directory (working-directory) (elt subdirs (1- answer)))))
  +           (t (load (cdr (elt files (- answer (length subdirs) 1)))
  +                    :verbose t)))))))
       
   
   (defun resolve (path &key (directory nil))
  
positive.code:   (apply (function more) :page nil paths))
    
  
  (DEFVAR *DIRECTORY-STACK* NIL)
  
  
  (DEFUN CD (&OPTIONAL PATH)
    "COMMAND
  DO:         Change the working directory.
  ARGUMENTS:  The path of the new working directory.
              If not given, then change to the user home directory.
  "
    (CHANGE-WORKING-DIRECTORY
     (if path
         (resolve path  :directory t)
         (USER-HOMEDIR-PATHNAME))))
  
  
  (DEFUN PWD   ()
    "COMMAND
  DO:         Returns the current working directory.
  "
    (WORKING-DIRECTORY))
  
  
  (DEFUN POPD  ()
    "COMMAND
  DO:         Unstack the working directory from the stack.
  "
    (IF *DIRECTORY-STACK*
        (CONS (CHANGE-WORKING-DIRECTORY (POP *DIRECTORY-STACK*)) *DIRECTORY-STACK*)
        (LIST (WORKING-DIRECTORY))))
  
  
  (DEFUN PUSHD (&OPTIONAL PATH)
    "COMMAND
  DO:         Push the current working directory onto the stack, and
              change the working directory to the path (or home directory).
  SEE;        POPD, CD.
  "
    (IF PATH
        (PROGN
          (PUSH (WORKING-DIRECTORY) *DIRECTORY-STACK*)
          (CONS (CD PATH) *DIRECTORY-STACK*))
        (LET ((TOP (POP *DIRECTORY-STACK*)))
          (PUSH (WORKING-DIRECTORY) *DIRECTORY-STACK*)
          (CONS (CD TOP)  *DIRECTORY-STACK*))))
  
  
  ;;;; THE END ;;;;
  
negative.code:   (let* ((non-existent
            (find-if-not
             (lambda (dir)
               
               ;; We cannot use directory to check whether a directory
               ;; exists.  So we try a file pattern, and if not found
               ;; but no error is signaled, assume the directory exists.
               
               ;; Of course, this doesn't work on some implementations
               ;; such as ccl.
  
               ;; On ccl, if we try to create a file in an inexistant
               ;; directory, it will create it!!!  But we can use
               ;; probe-file to test directories in ccl…
  
  
               (ignore-errors
                 (or
                  #-ccl (directory (make-pathname :directory dir :name "RARE" :type "RARE" :defaults path))
                  #+ccl (probe-file path)
                  t))
               )
             (nreverse
              (loop
                 :for dir :on (reverse (pathname-directory path))
  