Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fix native namesting usage on SBCL and CCL

  • Loading branch information...
commit 067fc6b04e93a7d0968552110a7f28b91def7d97 1 parent ac7bc8b
Valeriy Zamarayev valeryz authored

Showing 1 changed file with 10 additions and 5 deletions. Show diff stats Hide diff stats

  1. +10 5 quickdist.lisp
15 quickdist.lisp
@@ -64,12 +64,17 @@ system-index-url: {base-url}/{name}/{version}/systems.txt
64 64 (defun last-directory (path)
65 65 (first (last (pathname-directory path))))
66 66
  67 +(defun native-namestring (path)
  68 + #+ccl(ccl:native-translated-namestring path)
  69 + #+sbcl(sb-ext:native-namestring path)
  70 + #-(or ccl sbcl)(native-namestring path))
  71 +
67 72 (defun archive (destdir-path source-path)
68 73 (let* ((mtime (format-date (effective-mtime source-path)))
69 74 (name (format nil "~a-~a" (last-directory source-path) mtime))
70 75 (out-path (make-pathname :name name :type "tgz" :defaults (truename destdir-path))))
71   - (external-program:run *gnutar* (list "-C" (namestring source-path) "."
72   - "-czf" (namestring out-path)
  76 + (external-program:run *gnutar* (list "-C" (native-namestring source-path) "."
  77 + "-czf" (native-namestring out-path)
73 78 "--transform" (format nil "s#^.#~a#" name))
74 79 :output *standard-output* :error *error-output*)
75 80 out-path))
@@ -109,8 +114,8 @@ system-index-url: {base-url}/{name}/{version}/systems.txt
109 114 (format nil "~a.~a" (pathname-name path) (pathname-type path)))
110 115
111 116 (defun unix-filename-relative-to (base path)
112   - (let ((base-name (namestring (truename base)))
113   - (path-name (namestring (truename path))))
  117 + (let ((base-name (native-namestring (truename base)))
  118 + (path-name (native-namestring (truename path))))
114 119 (subseq path-name (mismatch base-name path-name))))
115 120
116 121 (defun create-dist (projects-path dist-path archive-path archive-url)
@@ -146,7 +151,7 @@ system-index-url: {base-url}/{name}/{version}/systems.txt
146 151 (projects-path (fad:pathname-as-directory projects-dir))
147 152 (template-data (list :name name :version version
148 153 :base-url (string-right-trim "/" base-url)
149   - :dists-dir (string-right-trim "/" (namestring dists-dir))))
  154 + :dists-dir (string-right-trim "/" (native-namestring dists-dir))))
150 155 (distinfo-path (fad:pathname-as-file (render-template *distinfo-file-template* template-data)))
151 156 (dist-path (fad:pathname-as-directory (render-template *dist-dir-template* template-data)))
152 157 (archive-path (fad:pathname-as-directory (render-template *archive-dir-template* template-data)))

0 comments on commit 067fc6b

Please sign in to comment.
Something went wrong with that request. Please try again.