Skip to content

Commit d148f2d

Browse files
committed
Now QL supports distributions with slash in their names.
This makes possible to use custom distributions, hosted at Ultralisp.org. These custom distribution has names of from `username/dist-name` and distinfo.txt file looks like this: name: svetlyak40wt/my-forks version: 20210112065000 distinfo-subscription-url: http://dist.ultralisp.org/svetlyak40wt/my-forks.txt distinfo-template-url: http://dist.ultralisp.org/svetlyak40wt/my-forks/{{version}}/distinfo.txt release-index-url: http://dist.ultralisp.org/svetlyak40wt/my-forks/20210112065000/releases.txt system-index-url: http://dist.ultralisp.org/svetlyak40wt/my-forks/20210112065000/systems.txt Such names also make sense as a URL's part. That is why I think it is good idea to support them in QuickLisp client.
1 parent b525ae5 commit d148f2d

File tree

3 files changed

+19
-8
lines changed

3 files changed

+19
-8
lines changed

quicklisp/dist.lisp

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -497,7 +497,9 @@
497497
(defun dist-name-pathname (name)
498498
"Return the pathname that would be used for an installed dist with
499499
the given NAME."
500-
(qmerge (make-pathname :directory (list :relative "dists" name))))
500+
(qmerge (make-pathname :directory (list* :relative
501+
"dists"
502+
(split-slashes name)))))
501503

502504
(defmethod slot-unbound (class (dist dist) (slot (eql 'base-directory)))
503505
(declare (ignore class))
@@ -577,7 +579,7 @@ the given NAME."
577579

578580
(defun standard-dist-enumeration-function ()
579581
"The default function used for producing a list of dist objects."
580-
(loop for file in (directory (qmerge "dists/*/distinfo.txt"))
582+
(loop for file in (directory (qmerge "dists/**/distinfo.txt"))
581583
collect (make-dist-from-file file)))
582584

583585
(defun all-dists ()

quicklisp/package.lisp

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
#:delete-file-if-exists
1313
#:ensure-file-exists
1414
#:split-spaces
15+
#:split-slashes
1516
#:first-line
1617
#:file-size
1718
#:safely-read

quicklisp/utils.lisp

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -56,29 +56,31 @@
5656
(when (probe-file pathname)
5757
(delete-file pathname)))
5858

59-
(defun split-spaces (line)
59+
(defun split (line delimiter)
6060
(let ((words '())
6161
(mark 0)
6262
(pos 0))
6363
(labels ((finish ()
6464
(setf pos (length line))
6565
(save)
66-
(return-from split-spaces (nreverse words)))
66+
(return-from split (nreverse words)))
6767
(save ()
6868
(when (< mark pos)
6969
(push (subseq line mark pos) words)))
7070
(mark ()
7171
(setf mark pos))
7272
(in-word (char)
73-
(case char
74-
(#\Space
73+
(cond
74+
((char= char
75+
delimiter)
7576
(save)
7677
#'in-space)
7778
(t
7879
#'in-word)))
7980
(in-space (char)
80-
(case char
81-
(#\Space
81+
(cond
82+
((char= char
83+
delimiter)
8284
#'in-space)
8385
(t
8486
(mark)
@@ -88,6 +90,12 @@
8890
(setf pos i)
8991
(setf state (funcall state (char line i))))))))
9092

93+
(defun split-spaces (line)
94+
(split line #\Space))
95+
96+
(defun split-slashes (line)
97+
(split line #\/))
98+
9199
(defun first-line (file)
92100
(with-open-file (stream file)
93101
(values (read-line stream))))

0 commit comments

Comments
 (0)