Skip to content

Commit 996fec5

Browse files
xachxach
committed
Initial commit.
0 parents  commit 996fec5

21 files changed

+3934
-0
lines changed

‎LICENSE.txt

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
Copyright (c) 2010 Zachary Beane <[email protected]>
2+
3+
Permission is hereby granted, free of charge, to any person obtaining a copy
4+
of this software and associated documentation files (the "Software"), to deal
5+
in the Software without restriction, including without limitation the rights
6+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
7+
copies of the Software, and to permit persons to whom the Software is
8+
furnished to do so, subject to the following conditions:
9+
10+
The above copyright notice and this permission notice shall be included in
11+
all copies or substantial portions of the Software.
12+
13+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
18+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
19+
THE SOFTWARE.

‎Makefile

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
all:
2+
git archive --format=tar --prefix=quicklisp/ HEAD > quicklisp.tar
3+
gzip -c quicklisp.tar > quicklisp-`cat version.txt`.tgz
4+

‎README.txt

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
This is the client portion of Quicklisp. It is responsible for
2+
downloading and managing project metadata, downloading and installing
3+
project releases, loading system files, and performing code, data, and
4+
metadata updates.
5+
6+
For more information about the Quicklisp client, please see:
7+
8+
http://www.quicklisp.org/beta/
9+
10+
For more information about Quicklisp, please see:
11+
12+
http://www.quicklisp.org/
13+
14+
If you have questions or comments about this project, please email
15+
Zach Beane <[email protected]>.
16+
17+
18+
Portions of this client (deflate.lisp) are derived from Pierre Mai's
19+
Deflate library, which is licensed under the following terms:
20+
21+
Deflate --- RFC 1951 Deflate Decompression
22+
23+
Copyright (C) 2000-2009 PMSF IT Consulting Pierre R. Mai.
24+
25+
Permission is hereby granted, free of charge, to any person obtaining
26+
a copy of this software and associated documentation files (the
27+
"Software"), to deal in the Software without restriction, including
28+
without limitation the rights to use, copy, modify, merge, publish,
29+
distribute, sublicense, and/or sell copies of the Software, and to
30+
permit persons to whom the Software is furnished to do so, subject to
31+
the following conditions:
32+
33+
The above copyright notice and this permission notice shall be
34+
included in all copies or substantial portions of the Software.
35+
36+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
37+
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
38+
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
39+
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR
40+
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
41+
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
42+
OTHER DEALINGS IN THE SOFTWARE.
43+
44+
Except as contained in this notice, the name of the author shall
45+
not be used in advertising or otherwise to promote the sale, use or
46+
other dealings in this Software without prior written authorization
47+
from the author.
48+
49+

‎client-update.lisp

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
;;;; client-update.lisp
2+
3+
(in-package #:quicklisp-client)
4+
5+
(defun version-from-file (file)
6+
(with-open-file (stream file)
7+
(let ((version-string (read-line stream)))
8+
(when (every #'digit-char-p version-string)
9+
(values (parse-integer version-string))))))
10+
11+
(defun local-version ()
12+
(version-from-file (qmerge "quicklisp/version.txt")))
13+
14+
(defun upstream-version ()
15+
(let ((local-file (qmerge "tmp/client-update/version.txt")))
16+
(ensure-directories-exist local-file)
17+
(fetch "http://beta.quicklisp.org/quickstart/version.txt"
18+
local-file :quietly t)
19+
(prog1 (version-from-file local-file)
20+
(delete-file local-file))))
21+
22+
(defun update-available-p ()
23+
(< (local-version) (upstream-version)))
24+
25+
(defun upstream-archive-url (version)
26+
(format nil "http://beta.quicklisp.org/quickstart/quicklisp-~D.tgz"
27+
version))
28+
29+
(defvar *upstream-asdf-url*
30+
"http://beta.quicklisp.org/quickstart/asdf.lisp")
31+
32+
(defvar *upstream-setup-url*
33+
"http://beta.quicklisp.org/quickstart/setup.lisp")
34+
35+
(defun retirement-directory (base)
36+
(let ((suffix 0))
37+
(loop
38+
(incf suffix)
39+
(let* ((try (format nil "~A-~D" base suffix))
40+
(dir (qmerge (make-pathname :directory
41+
(list :relative "retired" try)))))
42+
(unless (ignore-errors (truename dir))
43+
(return dir))))))
44+
45+
(defun update-client (&key (prompt t))
46+
(let ((upstream-version (upstream-version))
47+
(local-version (local-version)))
48+
(when (<= upstream-version local-version)
49+
(format t "Installed version ~D is as new as upstream version ~D. No update.~%"
50+
local-version upstream-version)
51+
(return-from update-client t))
52+
(format t "Updating from version ~D to version ~D.~%"
53+
local-version upstream-version)
54+
(when prompt
55+
(unless (press-enter-to-continue)
56+
(return-from update-client nil)))
57+
(let* ((work-dir (qmerge (make-pathname
58+
:directory
59+
(list :relative
60+
"tmp"
61+
"client-update"
62+
(princ-to-string upstream-version)))))
63+
(upstream-archive (merge-pathnames "quicklisp.tgz" work-dir))
64+
(upstream-tar (merge-pathnames "quicklisp.tar" work-dir))
65+
(upstream-unpacked (merge-pathnames "quicklisp/" work-dir))
66+
(retired (retirement-directory (format nil "quicklisp-~D"
67+
local-version)))
68+
(current-dir (qmerge "quicklisp/")))
69+
(ensure-directories-exist (qmerge "retired/"))
70+
(ensure-directories-exist upstream-archive)
71+
(fetch (upstream-archive-url upstream-version) upstream-archive)
72+
(gunzip upstream-archive upstream-tar)
73+
(unpack-tarball upstream-tar :directory work-dir)
74+
(rename-directory current-dir retired)
75+
(rename-directory upstream-unpacked current-dir)
76+
;; A little crude; should version these, too
77+
(fetch *upstream-setup-url* (qmerge "setup.lisp"))
78+
(fetch *upstream-asdf-url* (qmerge "asdf.lisp"))
79+
(format t "~&New quicklisp client installed. ~
80+
It will take effect on restart.~%")
81+
t)))

‎client.lisp

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
;;;; client.lisp
2+
3+
(in-package #:quicklisp-client)
4+
5+
(defvar *quickload-verbose* nil)
6+
(defvar *quickload-prompt* nil)
7+
(defvar *quickload-explain* t)
8+
9+
(define-condition system-not-quickloadable (error)
10+
((system
11+
:initarg :system
12+
:reader not-quickloadable-system)))
13+
14+
(defgeneric quickload (systems &key verbose prompt explain &allow-other-keys)
15+
(:documentation
16+
"Load SYSTEMS the quicklisp way. SYSTEMS is a designator for a list
17+
of things to be loaded.")
18+
(:method (systems &key prompt verbose &allow-other-keys)
19+
(unless (consp systems)
20+
(setf systems (list systems)))
21+
(dolist (thing systems systems)
22+
(flet ((ql ()
23+
(autoload-system-and-dependencies thing :prompt prompt)))
24+
(if verbose
25+
(ql)
26+
(call-with-quiet-compilation #'ql))))))
27+
28+
(defun system-list ()
29+
(provided-systems t))
30+
31+
(defun update-dist (dist &key (prompt t))
32+
(when (stringp dist)
33+
(setf dist (find-dist dist)))
34+
(let ((new (available-update dist)))
35+
(cond (new
36+
(show-update-report dist new)
37+
(when (or (not prompt) (press-enter-to-continue))
38+
(update-in-place dist new)))
39+
(t
40+
(format t "~&No update available for ~S."
41+
(short-description dist))))))
42+
43+
(defun update-all-dists (&key (prompt t))
44+
(dolist (old (all-dists))
45+
(with-simple-restart (skip "Skip update of dist ~S" (name old))
46+
(update-dist old :prompt prompt))))
47+
48+
(defun help ()
49+
"For help with this demo, see http://www.quicklisp.org/demo/")

‎config.lisp

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
;;;; config.lisp
2+
3+
(in-package #:ql-config)
4+
5+
(defun config-value-file-pathname (path)
6+
(let ((bad-position (position #\Space path)))
7+
(when bad-position
8+
(error "Space not allowed at position ~D in ~S"
9+
bad-position
10+
path)))
11+
(let* ((space-path (substitute #\Space #\/ path))
12+
(split (split-spaces space-path))
13+
(directory-parts (butlast split))
14+
(name (first (last split)))
15+
(base (qmerge "config/")))
16+
(merge-pathnames
17+
(make-pathname :name name
18+
:type "txt"
19+
:directory (list* :relative directory-parts))
20+
base)))
21+
22+
(defun config-value (path)
23+
(let ((file (config-value-file-pathname path)))
24+
(with-open-file (stream file :if-does-not-exist nil)
25+
(when stream
26+
(values (read-line stream nil))))))
27+
28+
(defun (setf config-value) (new-value path)
29+
(let ((file (config-value-file-pathname path)))
30+
(ensure-directories-exist file)
31+
(with-open-file (stream file :direction :output
32+
:if-does-not-exist :create
33+
:if-exists :rename-and-delete)
34+
(write-line new-value stream))))

0 commit comments

Comments
 (0)