6 lines
549 B
Common Lisp
6 lines
549 B
Common Lisp
(defun common-directory-path (&rest paths)
|
|
(do* ((pathnames (mapcar #'(lambda (path) (cdr (pathname-directory (pathname path)))) paths)) ; convert strings to lists of subdirectories
|
|
(rem pathnames (cdr rem))
|
|
(pos (length (first rem))) ) ; position of first mismatched element
|
|
((null (cdr rem)) (make-pathname :directory (cons :absolute (subseq (first pathnames) 0 pos)))) ; take the common sublists and convert back to a pathname
|
|
(setq pos (min pos (mismatch (first rem) (second rem) :test #'string-equal))) )) ; compare two paths
|