Permalink
Browse files

Prettier output from the command line interface

  • Loading branch information...
1 parent d234004 commit b76ad4fa05c5154e5f32ce896408775bb9dc9483 @per-gron committed Nov 10, 2011
Showing with 40 additions and 9 deletions.
  1. +4 −1 src/cli.scm
  2. +1 −0 src/compile-load.scm
  3. +6 −2 src/extras.scm
  4. +19 −5 src/loader.scm
  5. +10 −1 src/packages.scm
View
@@ -253,6 +253,7 @@
(display "Cleaning modules...\n" port)
(for-each
(lambda (mod)
+ (display " * " port)
(display (path-normalize (module-reference-path mod)
'shortest)
port)
@@ -321,7 +322,9 @@
(lambda (dep)
(if (not quiet)
(print " * "))
- (write (module-reference-path dep))
+ (print (loader-prettify-path
+ (module-reference-loader dep)
+ (module-reference-path dep)))
(newline))
deps)))
args))
View
@@ -371,6 +371,7 @@
(for-each
(lambda (mod c-file file)
+ (display " * " port)
(display (if verbose
file
(path-strip-directory file))
View
@@ -71,11 +71,15 @@
(display "Compiling " port)
(write nmods port)
- (display " modules\n" port)
+ (display " modules...\n" port)
(for-each
(lambda (mod)
- (write (module-reference-path mod) port)
+ (display " * " port)
+ (display (loader-prettify-path
+ (module-reference-loader mod)
+ (module-reference-path mod))
+ port)
(display " (" port)
(write file-number port)
(display "/" port)
View
@@ -28,7 +28,10 @@
;; Takes two absolute paths and returns true if the first argument is
;; less than the other in some sense. This function is set to string<?
;; by default.
- (path<?-fn unprintable: equality-skip: read-only:))
+ (path<?-fn unprintable: equality-skip: read-only:)
+ ;; Takes an absolute path as argument and returns a human-friendly
+ ;; string. It is used for things like command line output.
+ (prettify-path-fn unprintable: equality-skip: read-only:))
(define (loader<? a b)
(string<? (symbol->string (loader-name a))
@@ -52,6 +55,9 @@
(define (loader-module-name loader path)
((loader-module-name-fn loader) path))
+(define (loader-prettify-path loader path)
+ ((loader-prettify-path-fn loader) path))
+
(define loader-registry (make-table))
(define (make-loader #!key
@@ -62,15 +68,17 @@
load-module
compare-stamp
module-name
- (path<? string<?))
+ (path<? string<?)
+ (prettify-path (lambda (x) x)))
(if (not (and (symbol? name)
(procedure? path-absolute?)
(procedure? path-absolutize)
(procedure? real-path)
(procedure? load-module)
(procedure? compare-stamp)
(procedure? module-name)
- (procedure? path<?)))
+ (procedure? path<?)
+ (procedure? prettify-path)))
(error "Invalid parameters"))
(let ((result
(make-loader/internal name
@@ -80,7 +88,8 @@
load-module
compare-stamp
module-name
- path<?)))
+ path<?
+ prettify-path)))
(table-set! loader-registry name result)
result))
@@ -104,6 +113,7 @@
#f
#f
#f
+ #f
#f))
(define (skeleton->loader loader)
@@ -264,7 +274,11 @@
((string? path)
(path-strip-extension path))
(else
- (error "Invalid path" path)))))))
+ (error "Invalid path" path)))))
+
+ prettify-path:
+ (lambda (path)
+ (path-normalize path 'shortest))))
(define black-hole-module-loader
(make-loader
View
@@ -746,7 +746,16 @@
(and (equal? a-pkg b-pkg)
(or (version<? a-ver b-ver)
(and (version=? a-ver b-ver)
- (string<? a-id b-id)))))))))
+ (string<? a-id b-id)))))))
+
+ prettify-path:
+ (lambda (path)
+ (string-append
+ (package-module-path-name path)
+ "-"
+ (symbol->string (package-module-path-version path))
+ ":"
+ (package-module-path-id path)))))
;;; Package installation and uninstallation

0 comments on commit b76ad4f

Please sign in to comment.