[lispy-cvs] CVS lispy
mkennedy
mkennedy at common-lisp.net
Sun Jul 22 02:59:50 UTC 2007
Update of /project/lispy/cvsroot/lispy
In directory clnet:/tmp/cvs-serv3064
Modified Files:
lispy.asd lispy.lisp packages.lisp specials.lisp
Log Message:
Added distributed map support.
Load a configuration after loading the system but before initialization.
--- /project/lispy/cvsroot/lispy/lispy.asd 2007/07/12 05:56:04 1.3
+++ /project/lispy/cvsroot/lispy/lispy.asd 2007/07/22 02:59:50 1.4
@@ -18,4 +18,8 @@
#:cl-fad))
(defmethod perform :after ((o load-op) (c (eql (find-system 'lispy))))
+ (let ((lispy-config (merge-pathnames #p".lispy.lisp"(user-homedir-pathname))))
+ (if (probe-file lispy-config)
+ (load lispy-config)
+ (warn "Lispy configuration not found at ~A" lispy-config)))
(funcall (intern "INITIALIZE" (find-package "LISPY"))))
--- /project/lispy/cvsroot/lispy/lispy.lisp 2007/07/21 07:08:55 1.7
+++ /project/lispy/cvsroot/lispy/lispy.lisp 2007/07/22 02:59:50 1.8
@@ -5,7 +5,8 @@
((name :initarg :name :reader name)
(homepage :initarg :homepage :reader homepage)
(description :initarg :description :reader description)
- (versions :initarg :versions :reader versions)))
+ (versions :initarg :versions :reader versions)
+ (map-url :initarg :map-url :reader map-url)))
(defgeneric latest-version (module))
@@ -35,6 +36,7 @@
(defclass version ()
((name :initarg :name :reader name)
+ (map-url :initarg :map-url :reader map-url)
(our-version :initarg :our-version :reader our-version)
(version :initarg :version :reader version)
(source :initarg :source :reader source)
@@ -56,20 +58,27 @@
(defun module-by-name (name)
(gethash name *lispy-map*))
-(defun read-map (&optional (map-url *lispy-map-url*))
- (log-message "read-map" "Reading ~A" (uri-to-string *lispy-map-url*))
+(defun read-map (map-url)
+ (log-message "read-map" "Reading ~A" (uri-to-string map-url))
(multiple-value-bind (stream status-code headers uri http-stream must-close)
(drakma:http-request map-url :want-stream t)
(declare (ignore status-code headers uri http-stream must-close))
(unwind-protect
- (dolist (module (mapcar #'parse-module (read stream)))
+ (dolist (module (mapcar #'(lambda (m)
+ (parse-module m map-url))
+ (read stream)))
(setf (gethash (name module) *lispy-map*)
module))
- (close stream)))
- (log-message "read-map" "Map contains ~A entr~:@p" (hash-table-count *lispy-map*))
+ (close stream))))
+
+(defun read-maps (&optional (map-urls *lispy-map-urls*))
+ (dolist (map-url map-urls)
+ (read-map map-url))
+ (log-message "read-maps" "Map contains ~A entr~:@p"
+ (hash-table-count *lispy-map*))
*lispy-map*)
-(defun parse-module (module)
+(defun parse-module (module map-url)
(destructuring-bind (&key name homepage description versions)
module
(make-instance 'module
@@ -77,10 +86,11 @@
:homepage homepage
:description description
:versions (mapcar #'(lambda (v)
- (parse-version name v))
- versions))))
+ (parse-version name v map-url))
+ versions)
+ :map-url map-url)))
-(defun parse-version (name version)
+(defun parse-version (name version map-url)
(destructuring-bind (&key our-version version source md5sum root asdf-paths dependencies)
version
(make-instance 'version
@@ -91,7 +101,8 @@
:md5sum md5sum
:root root
:asdf-paths (or asdf-paths (list root))
- :dependencies dependencies)))
+ :dependencies dependencies
+ :map-url map-url)))
(defclass install ()
((name :initarg :name :reader name)
@@ -184,7 +195,7 @@
(fetch (latest-version module)))
(defmethod fetch ((version version))
- (log-message "fetch" "Fetching ~A" (uri-to-string (make-fetch-url (source version))))
+ (log-message "fetch" "Fetching ~A" (uri-to-string (make-fetch-url (source version) (map-url version))))
(ensure-directories-exist *lispy-distfiles-pathname*)
(let ((pathname (merge-pathnames (source version) *lispy-distfiles-pathname*)))
(if (and (probe-file pathname )
@@ -194,7 +205,7 @@
(version version))
(progn
(multiple-value-bind (stream status-code headers uri http-stream must-close)
- (drakma:http-request (make-fetch-url (source version))
+ (drakma:http-request (make-fetch-url (source version) (map-url version))
:force-binary t
:want-stream t)
(declare (ignore status-code headers uri http-stream must-close))
@@ -209,10 +220,10 @@
(unless (compare-to-md5sum pathname (md5sum version))
(error "MD5 checksum for ~S failed" (source version)))))))
-(defun make-fetch-url (source)
- (let ((parsed-path (append (butlast (puri:uri-parsed-path *lispy-map-url*))
+(defun make-fetch-url (source map-url)
+ (let ((parsed-path (append (butlast (puri:uri-parsed-path map-url))
(list "distfiles" source))))
- (let ((result (puri:copy-uri *lispy-map-url*)))
+ (let ((result (puri:copy-uri map-url)))
(setf (puri:uri-parsed-path result)
parsed-path)
result)))
@@ -273,7 +284,7 @@
(setf *lispy-installation* (make-hash-table :test 'eq)
*lispy-map* (make-hash-table :test 'eq))
(log-message "initialize" "Initializing Lispy system on ~A ~A" (lisp-implementation-type) (lisp-implementation-version))
- (read-map)
+ (read-maps)
(read-installation)
(write-asdf-config)
(read-asdf-config)
--- /project/lispy/cvsroot/lispy/packages.lisp 2007/07/14 05:11:54 1.3
+++ /project/lispy/cvsroot/lispy/packages.lisp 2007/07/22 02:59:50 1.4
@@ -1,7 +1,7 @@
(defpackage #:lispy
(:use #:common-lisp)
- (:export #:*lispy-map-url*
+ (:export #:*lispy-map-urls*
#:*lispy-pathname*
#:*lispy-installation-pathname*
#:*lispy-asdf-config-pathname*
--- /project/lispy/cvsroot/lispy/specials.lisp 2007/07/12 07:20:23 1.3
+++ /project/lispy/cvsroot/lispy/specials.lisp 2007/07/22 02:59:50 1.4
@@ -1,6 +1,7 @@
(in-package #:lispy)
-(defvar *lispy-map-url* (puri:parse-uri "http://common-lisp.net/project/lispy/repository/map.lisp-expr"))
+(defvar *lispy-map-urls*
+ (list (puri:parse-uri "http://common-lisp.net/project/lispy/repository/map.lisp-expr")))
(defvar *lispy-pathname*
(let ((path (make-pathname :name nil :type nil :version nil :defaults (parse-namestring *load-truename*))))
More information about the Lispy-cvs
mailing list