# Pastebin YaeOFBLg
(defun shorten (pathname n)
  (let* ((directory (pathname-directory pathname))
	 (key (first directory))
	 (truncated (subseq (rest directory) 0 n)))
    (make-pathname :defaults pathname
		   :directory (append (list key) truncated))))