support non-existance of ~/common-lisp

This commit is contained in:
David Botton 2022-08-22 18:47:18 -04:00
parent c65e0a2856
commit 51b8d57d05

View file

@ -2157,20 +2157,23 @@ of controls and double click to select control."
(win panel) "Enter new system name:" (win panel) "Enter new system name:"
(lambda (sys-name) (lambda (sys-name)
(cond (sys-name (cond (sys-name
(server-file-dialog (let ((fname (if (uiop:directory-exists-p #P"~/common-lisp/")
(win panel) "Output Directory" "~/common-lisp/" #P"~/common-lisp/"
(lambda (filename) (car ql:*local-project-directories*))))
(cond (filename (server-file-dialog
(template-copy sys-name start-dir filename :panel (window-content (win panel))) (win panel) "Output Directory" fname
(when (getf tmpl-rec :www) (lambda (filename)
(template-copy sys-name www-dir filename :panel (window-content (win panel)))) (cond (filename
(asdf:clear-source-registry) (template-copy sys-name start-dir filename :panel (window-content (win panel)))
(when (project-win app) (when (getf tmpl-rec :www)
(clog-gui:window-close (project-win app))) (template-copy sys-name www-dir filename :panel (window-content (win panel))))
(on-show-project panel :project sys-name) (asdf:clear-source-registry)
(create-div (window-content (win panel)) :content "<hr><b>done.</b>")) (when (project-win app)
(t (clog-gui:window-close (project-win app)))
(window-close (win panel))))))) (on-show-project panel :project sys-name)
(create-div (window-content (win panel)) :content "<hr><b>done.</b>"))
(t
(window-close (win panel))))))))
(t (t
(window-close (win panel)))))))) (window-close (win panel))))))))