mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-15 15:00:24 -08:00
Code Issues Projects Releases Wiki Activity

fix for win64 :rename-and-delete

Browse source
This commit is contained in:
David Botton 2024-05-05 23:37:20 -04:00
parent 7a3f0ddace
commit 4e5cc847b5
2 changed files with 18 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

3
tools/clog-builder-project-tree.lisp
View file

@ -117,13 +117,14 @@
(window-focus win)) (window-focus win))
(on-change (obj) (on-change (obj)
(declare (ignore obj)) (declare (ignore obj))
(setf (text-value load-btn) "loading")
(setf (text tree) "")
(let* ((sel (value projects)) (let* ((sel (value projects))
(root (quicklisp:where-is-system sel)) (root (quicklisp:where-is-system sel))
(dir (directory-namestring (uiop:truename* root)))) (dir (directory-namestring (uiop:truename* root))))
(cond (root (cond (root
(setf (current-project app) sel) (setf (current-project app) sel)
(setf (text-value load-btn) "not loaded") (setf (text-value load-btn) "not loaded")
(setf (text tree) "")
(create-clog-tree tree (create-clog-tree tree
:fill-function (lambda (obj) :fill-function (lambda (obj)
(project-tree-dir-select obj dir)) (project-tree-dir-select obj dir))

16
tools/clog-builder.lisp
View file

@ -586,3 +586,19 @@ instead of the project window will be displayed."
(when start-browser (when start-browser
(format t "~%If browser does not start go to http://127.0.0.1:~A/builder~%~%" port) (format t "~%If browser does not start go to http://127.0.0.1:~A/builder~%~%" port)
(open-browser :url (format nil "http://127.0.0.1:~A/builder" port)))) (open-browser :url (format nil "http://127.0.0.1:~A/builder" port))))
(in-package #:quicklisp-client)
;; patch, if-exists of :rename-and-delete does not work well on windows
(defun make-system-index (pathname)
"Create a system index file for all system files under
PATHNAME. Current format is one native namestring per line."
(setf pathname (truename pathname))
(with-open-file (stream (system-index-file pathname)
:direction :output
:if-exists :overwrite)
(dolist (system-file (local-project-system-files pathname))
(let ((system-path (enough-namestring system-file pathname)))
(write-line (native-namestring system-path) stream)))
(probe-file stream)))