Commit a97ccc3e authored by Eric Timmons's avatar Eric Timmons
Browse files

Fixes for bugs found while testing client

parent dca11bb4
......@@ -12,7 +12,5 @@ CLPMFILE) to the new clpmfile."
(with-clpm-proc (proc)
(clpm-proc-print
proc
`(with-bundle-default-pathname-defaults (,clpmfile)
(with-bundle-local-config (,clpmfile)
(bundle-init :clpmfile ,clpmfile :asds ',asds)))))
clpmfile)
`(bundle-init :clpmfile ,clpmfile :asds ',asds))
(clpm-proc-read proc)))
......@@ -137,7 +137,8 @@ directories containing the files."
(clpm-proc-print proc `(output-translations :context ,context))
(clpm-proc-read proc)))
(defun context-source-registry (&key (context (default-context)) ignore-inherited)
(defun context-source-registry (&key (context (default-context))
(ignore-inherited (context-bundle-p context)))
"Return a source-registry form for the CONTEXT."
(with-clpm-proc (proc)
(clpm-proc-print proc `(source-registry :context ,context :ignore-inherited-source-registry ,ignore-inherited))
......
......@@ -51,31 +51,35 @@
"Returns a list of 5 integers detailing the column widths needed to print a
diff. The first column is the project name, then old version, new version, old
source, and finally new source."
(list (max (length "Project")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(length (release-diff-project-name release-diff)))
:initial-value 0))
(max (length "Old Version")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(length (release-diff-old-version release-diff)))
:initial-value 0))
(max (length "New Version")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(length (release-diff-new-version release-diff)))
:initial-value 0))
(max (length "Old Source")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(length (release-diff-old-source release-diff)))
:initial-value 0))
(max (length "New Source")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(length (release-diff-new-source release-diff)))
:initial-value 0))))
(flet ((printed-length (x)
(if (stringp x)
(length x)
(length (format nil "~A" x)))))
(list (max (length "Project")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(printed-length (release-diff-project-name release-diff)))
:initial-value 0))
(max (length "Old Version")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(printed-length (release-diff-old-version release-diff)))
:initial-value 0))
(max (length "New Version")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(printed-length (release-diff-new-version release-diff)))
:initial-value 0))
(max (length "Old Source")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(printed-length (release-diff-old-source release-diff)))
:initial-value 0))
(max (length "New Source")
(reduce #'max (context-diff-release-diffs diff)
:key (lambda (release-diff)
(printed-length (release-diff-new-source release-diff)))
:initial-value 0)))))
(defun print-context-diff-to-stream (diff stream)
"Print a human readable description of DIFF to STREAM."
......
......@@ -49,7 +49,7 @@ source registry is updated with the results."
:version ,version
:ref ,ref
:source ,source))
(list (source-registry :context ,context)
(list (source-registry :context ,context :ignore-inherited-source-registry ,(context-bundle-p context))
(installed-primary-system-names :context ,context)
(visible-primary-system-names :context ,context)
(editable-primary-system-names :context ,context))))
......
......@@ -34,7 +34,7 @@ source registry is updated with the results."
:update-systems ',(ensure-list systems)
:context ,context
:validate ,(make-diff-validator-fun)))
(list (source-registry :context ,context)
(list (source-registry :context ,context :ignore-inherited-source-registry ,(context-bundle-p context))
(installed-primary-system-names :context ,context)
(visible-primary-system-names :context ,context)
(editable-primary-system-names :context ,context))))
......
......@@ -27,21 +27,22 @@
(setup-logger)
(defun bundle-init (&key clpmfile (if-exists :error) asds)
(with-standard-io-syntax
(let ((*print-case* :downcase))
(with-open-file (s (clpmfile-pathname clpmfile) :direction :output :if-exists if-exists)
(write-string ";;; -*- Mode: common-lisp; -*-" s)
(terpri s)
(prin1 '(:api-version "0.3") s)
(terpri s)
(terpri s)
(dolist (source (sources))
(prin1 `(:source ,@(source-to-form source)) s)
(terpri s))
(terpri s)
(dolist (asd asds)
(prin1 `(:asd ,asd) s)
(terpri s)))))
(with-clpm-session ()
(with-standard-io-syntax
(let ((*print-case* :downcase))
(with-open-file (s (clpmfile-pathname clpmfile) :direction :output :if-exists if-exists)
(write-string ";;; -*- Mode: common-lisp; -*-" s)
(terpri s)
(prin1 '(:api-version "0.3") s)
(terpri s)
(terpri s)
(dolist (source (sources))
(prin1 `(:source ,@(source-to-form source)) s)
(terpri s))
(terpri s)
(dolist (asd asds)
(prin1 `(:asd ,asd) s)
(terpri s))))))
(clpmfile-pathname clpmfile))
(defun bundle-install (&key clpmfile (validate (constantly t)) no-resolve)
......
......@@ -328,7 +328,7 @@ in place with the same name. Return the new requirement if it was modified."
(t (:root ,@(rest (pathname-directory (clpm-cache-pathname '("bundle" "fasl-cache")
:ensure-directory t)))
,(urlencode (format nil "~{~A~^/~}" (rest (pathname-directory pathname))))
:implementation :** :*.*.*))))
:implementation :**/ :*.*.*))))
(:local
`(:output-translations
:ignore-inherited-configuration
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment