;;; -*- Mode:LISP; Package:USER -*-

(defun new-topdir(pl &optional (n "ADA") &aux p d)
  (setq p (car pl))
  (setq d (directory-namestring p))
  (setq d
	(string-append
	  (string-upcase n)
	  (substring d (string-search "." d) )))
  (print d)
  (fs:merge-pathnames d p))