diff --git a/install-lib-module.scm b/install-lib-module.scm
index 41a2686..ca17e83 100644
--- a/install-lib-module.scm
+++ b/install-lib-module.scm
@@ -1,10 +1,12 @@
 ;;; Installation library for scsh modules.
-;;; $Id: install-lib-module.scm,v 1.3 2004/01/04 14:34:32 frese Exp $
+;;; $Id: install-lib-module.scm,v 1.4 2004/02/01 23:12:26 frese Exp $
 
 ;;; Interfaces
 
 (define-interface install-interface
-  (export version->string
+  (export tmpl-libtool-la-reader
+
+          version->string
           string->version
           version-compare
           version<?
@@ -25,6 +27,9 @@
 
           get-directory
           get-option-value
+          with-output-to-load-script*
+          (with-output-to-load-script :syntax)
+          write-to-load-script
 
           install-main))
 
@@ -38,5 +43,6 @@
         srfi-9
         srfi-13
         srfi-37
-        configure)
+        configure
+        pp)
   (files install-lib))
diff --git a/install-lib.scm b/install-lib.scm
index 9387b8f..369a977 100644
--- a/install-lib.scm
+++ b/install-lib.scm
@@ -1,18 +1,56 @@
 ;;; Installation library for scsh modules.
-;;; $Id: install-lib.scm,v 1.3 2004/01/04 14:34:32 frese Exp $
+;;; $Id: install-lib.scm,v 1.4 2004/02/01 23:12:26 frese Exp $
 
 ;; TODO
+;; - add support for communication between configure and pkg-def.scm
 ;; - add support for image creation,
 ;; - add support to maintain a documentation index,
-;; - add "--verbose" to show whats being done.
-;; - add "--log" option to specify a log file.
-;; - decide what to do when target files already exist
+;; - maybe add a "--force" option to overwrite existing files
+
+;;
+;; Support code templates
+;;
+;; These templates are meant to be inserted in package-loading
+;; scripts.
+
+;; Template to parse libtool's ".la" files.
+(define tmpl-libtool-la-reader
+  '((define (normalize-la-entry key val)
+      (let ((left-quotes-rx (rx (: bos #\')))
+            (right-quotes-rx (rx (: #\' eos)))
+            (kill-matches
+             (lambda (rx str)
+               (regexp-substitute/global #f rx str 'pre 'post))))
+        (cons (string->symbol key)
+              (kill-matches left-quotes-rx
+                            (kill-matches right-quotes-rx val)))))
+    (define add-la-entry
+      (let ((splitter (infix-splitter (rx #\=)))
+            (comment-rx (rx (: bos #\#))))
+        (lambda (line alist)
+          (cond
+           ((and (not (regexp-search? comment-rx line))
+                 (string-index line #\=))
+            (let ((lst (splitter line)))
+              (if (= 2 (length lst))
+                  (cons (apply normalize-la-entry lst) alist)
+                  (error "Could not read la entry" line list))))
+           (else alist)))))
+    (define (read-libtool-la file-name)
+      (call-with-input-file
+          file-name
+        (lambda (port)
+          (let lp ((line (read-line port)) (alist '()))
+            (if (eof-object? line)
+                alist
+                (lp (read-line port) (add-la-entry line alist)))))))))
 
 ;;
 ;; Utilities
 ;;
 
-(define default-perms #o755)
+(define default-perms-fn
+  (lambda (name) #o755))
 
 ;; Return the name of the parent directory of FNAME.
 (define (parent-directory fname)
@@ -20,12 +58,13 @@
 
 ;; Create directory FNAME and all its parents, as needed.
 (define (create-directory&parents fname . rest)
-  (let-optionals rest ((perms default-perms))
+  (let-optionals rest ((perms-fn default-perms-fn))
     (let ((parent (parent-directory fname)))
       (if (not (file-exists? parent))
           (apply create-directory&parents parent rest))
       (if (not (file-exists? fname))
-            (-create-directory fname perms)))))
+          (-create-directory fname
+                             (perms-fn (absolute-file-name fname)))))))
 
 ;; Return the length of the longest prefix common to lists L1 and L2,
 ;; by comparing elements using PRED (defaults to EQUAL?).
@@ -54,17 +93,16 @@
         (path-list->file-name (append new-root-pl (cdr fname-pl)))
         (error "no root to replace in relative file name" fname))))
 
-;; Copy file/symlink SOURCE to TARGET and set the permisions of TARGET
-;; to PERMS. TARGET must be the name of a non-existing file (i.e. it
-;; cannot be the name of a directory).
-(define (copy-file source target perms)
+;; Copy file/symlink SOURCE to TARGET. TARGET must be the name of a
+;; non-existing file (i.e. it cannot be the name of a directory).
+(define (copy-file source target)
   (if (file-exists? target)
       (error "copy-file: target file exists" target))
   (if (file-symlink? source)
       (create-symlink (read-symlink source) target)
       (begin
         (run (cp ,source ,target))
-        (set-file-mode target perms))))
+        (set-file-mode target (file-mode source)))))
 
 ;; Like "load" but without printing anything.
 (define load-quietly
@@ -91,49 +129,47 @@
         ((not (null? rest)) (first rest))
         (else (error "internal error: cannot find key in alist" key alist))))
 
+;; Convert all arguments to strings using DISPLAY and concatenate the
+;; result in a single string which is returned.
+(define (as-string . args)
+  (call-with-string-output-port
+   (lambda (port) (for-each (lambda (arg) (display arg port)) args))))
+
 ;; Return a string of max(M,N) white spaces.
 (define (spaces m n) (make-string (max m n) #\space))
 
 ;;
-;; Support for dry runs.
+;; Support for dry runs / verbose operation.
 ;;
 
-(define (wrap-for-dry-run real-fn dry-fn)
+(define (wrap real-fn info-fn)
   (lambda args
-    (apply (if (get-option-value 'dry-run) dry-fn real-fn) args)))
-
-(define (dry-run-print msg . args)
-  (apply format #t msg args) (newline))
+    (if (or (get-option-value 'verbose) (get-option-value 'dry-run))
+        (begin (display (apply info-fn args)) (newline)))
+    (if (not (get-option-value 'dry-run))
+        (apply real-fn args))))
 
 (define -create-directory
-  (wrap-for-dry-run
-   create-directory
-   (lambda (fname . rest)
-     (let-optionals rest ((perms default-perms))
-       (dry-run-print "creating directory ~a with permissions ~a"
-                      fname
-                      (permissions->string perms))))))
+  (wrap create-directory
+        (lambda (fname . rest)
+          (let-optionals rest ((perms #o777))
+            (as-string "creating directory " fname
+                       " (perms: " (permissions->string perms) ")")))))
 
 (define -create-symlink
-  (wrap-for-dry-run
-   create-symlink
-   (lambda (old-name new-name)
-     (dry-run-print "creating symbolic link ~a pointing to ~a"
-                    new-name
-                    old-name))))
+  (wrap create-symlink
+        (lambda (old-name new-name)
+          (as-string "creating symbolic link " new-name
+                     " pointing to " old-name))))
 
 (define -copy-file
-  (wrap-for-dry-run
-   copy-file
-   (lambda (source target perms)
-     (dry-run-print "copying file ~a to ~a with permissions ~a"
-                    source
-                    target
-                    (permissions->string perms)))))
+  (wrap copy-file
+        (lambda (source target)
+          (as-string "copying file " source " to " target))))
 
 (define -delete-file
-  (wrap-for-dry-run delete-file
-                    (lambda (fname) (dry-run-print "deleting file ~a" fname))))
+  (wrap delete-file
+        (lambda (fname) (as-string "deleting file " fname))))
 
 ;;
 ;; Versions
@@ -368,6 +404,31 @@
            (else '())))
    packages))
 
+;;
+;; Load script handling
+;;
+
+;; Evaluate THUNK with CURRENT-OUTPUT-PORT opened on the current
+;; package's loading script (in the install directory). During a dry
+;; run, or when only non-shared data has to be installed, do nothing.
+(define (with-output-to-load-script* thunk)
+  (let ((dir (get-directory 'base #t)))
+    (create-directory&parents dir)
+    (if (not (or (get-option-value 'dry-run) (get-option-value 'non-shared-only)))
+        (with-output-to-file (absolute-file-name "load.scm" dir)
+          thunk))))
+
+;; Sugar for with-output-to-load-script*.
+(define-syntax with-output-to-load-script
+  (syntax-rules ()
+    ((with-output-to-load-script body ...)
+     (with-output-to-load-script* (lambda () body ...)))))
+
+;; Pretty-print all the elements of s-exps, one after the other, to
+;; the current package's loading script (in the install directory).
+(define (write-to-load-script s-exps)
+  (with-output-to-load-script (for-each p s-exps)))
+
 ;;
 ;; Actions
 ;;
@@ -383,7 +444,7 @@
                                          (file-name-directory lnk-name))
                      lnk-name)))
 
-(define (install-thing% layout name-or-pair location target-rel-dir perms)
+(define (install-thing% layout name-or-pair location target-rel-dir perms-fn)
   (let* ((target-dir (absolute-file-name target-rel-dir
                                          (layout-dir layout location)))
          (source (if (pair? name-or-pair) (car name-or-pair) name-or-pair))
@@ -391,33 +452,37 @@
                                                   (cdr name-or-pair)
                                                   name-or-pair)))
          (target (absolute-file-name target-name target-dir)))
-    (create-directory&parents target-dir perms)
+    (create-directory&parents target-dir perms-fn)
     (cond ((or (file-regular? source) (file-symlink? source))
-           (-copy-file source target perms))
+           (-copy-file source target))
           ((file-directory? source)
-           (-create-directory target perms)
+           (-create-directory target (file-mode source))
            (install-directory-contents% layout
                                         source
                                         location
                                         (absolute-file-name target-name
                                                             target-rel-dir)
-                                        perms))
+                                        perms-fn))
           (else (error "cannot install file-system object" source)))))
 
-(define (install-directory-contents% layout name location target-rel-dir perms)
+(define (install-directory-contents% layout
+                                     name
+                                     location
+                                     target-rel-dir
+                                     perms-fn)
   (for-each (lambda (thing)
-              (install-thing% layout thing location target-rel-dir perms))
+              (install-thing% layout thing location target-rel-dir perms-fn))
             (map (lambda (f) (absolute-file-name f name))
                  (directory-files name #t))))
 
 (define (install-thing name-or-pair location . rest)
   (if (active-location? location)
-      (let-optionals rest ((target-rel-dir ".") (perms default-perms))
+      (let-optionals rest ((target-rel-dir ".") (perms-fn default-perms-fn))
         (install-thing% (fluid *install-layout*)
                         name-or-pair
                         location
                         target-rel-dir
-                        perms))))
+                        perms-fn))))
 
 (define (install-things names-or-pairs . rest)
   (for-each (lambda (name-or-pair)
@@ -431,23 +496,12 @@
 
 (define (install-directory-contents name location . rest)
   (if (active-location? location)
-      (let-optionals rest ((target-rel-dir ".") (perms default-perms))
+      (let-optionals rest ((target-rel-dir ".") (perms-fn default-perms-fn))
         (install-directory-contents% (fluid *install-layout*)
                                      name
                                      location
                                      target-rel-dir
-                                     perms))))
-
-(define (install-empty-directory% layout name location dir . rest)
-  (let-optionals rest ((perms default-perms))
-    (-create-directory (absolute-file-name dir (layout-dir layout location))
-                       perms)))
-
-(define (install-empty-directory&parents% layout name location dir . rest)
-  (let-optionals rest ((perms default-perms))
-    (create-directory&parents
-     (absolute-file-name dir (layout-dir layout location))
-     perms)))
+                                     perms-fn))))
 
 (define *layout* (make-fluid #f))
 (define *install-layout* (make-fluid #f))
@@ -488,6 +542,7 @@ options:
   --layout <layout>    specify layout of installation directory
                        (predefined: ~a)
   --dry-run            don't do anything, print what would have been done
+  --verbose            print messages about what is being done
   --inactive           don't activate package after installing it
   --non-shared-only    only install platform-dependent files, if any
 
@@ -588,7 +643,8 @@ END
      (option '("non-shared-only") #f #f
              (alist-boolean-updater 'non-shared-only))
      (option '("inactive") #f #f (alist-boolean-updater 'inactive))
-     (option '("dry-run") #f #f (alist-boolean-updater 'dry-run)))))
+     (option '("dry-run") #f #f (alist-boolean-updater 'dry-run))
+     (option '("verbose") #f #f (alist-boolean-updater 'verbose)))))
 
 (define options-defaults
   `((prefix          . #f)
@@ -598,7 +654,8 @@ END
     (build           . ,(host))
     (non-shared-only . #f)
     (inactive        . #f)
-    (dry-run         . #f)))
+    (dry-run         . #f)
+    (verbose         . #f)))
 
 (define (parse-options args options defaults)
   (args-fold args
diff --git a/install-pkg b/install-pkg
index d0c96a9..8edafc6 100755
--- a/install-pkg
+++ b/install-pkg
@@ -1,3 +1,3 @@
 #!/bin/sh
-exec scsh -lm install-lib-module.scm -o configure -o install -e install-main -s "$0" "$@"
+exec scsh -lm install-lib-module.scm -o pp -o configure -o install -e install-main -s "$0" "$@"
 !#
diff --git a/load.scm.in b/load.scm.in
deleted file mode 100644
index 3ca9f38..0000000
--- a/load.scm.in
+++ /dev/null
@@ -1,78 +0,0 @@
-(user)
-(load-package 'dynamic-externals)
-(open 'dynamic-externals)
-(open 'external-calls)
-(open 'configure)
-(open 'signals)
-
-(run
- '(define (normalize-la-entry key val)
-    (let ((left-quotes-rx (rx (: bos #\')))
-	  (right-quotes-rx (rx (: #\' eos)))
-	  (kill-matches 
-	   (lambda (rx str)
-	     (regexp-substitute/global #f rx str 'pre 'post))))
-      (cons (string->symbol key)
-	    (kill-matches left-quotes-rx 
-			  (kill-matches right-quotes-rx val))))))
-  
-(run 
- '(define add-la-entry
-    (let ((splitter (infix-splitter (rx #\=)))
-	  (comment-rx (rx (: bos #\#))))
-      (lambda (line alist)
-	(cond 
-	 ((and (not (regexp-search? comment-rx line))
-	       (string-index line #\=))
-	  (let ((lst (splitter line)))
-	    (if (= 2 (length lst))
-		(cons (apply normalize-la-entry lst) alist)
-		(error "Could not read la entry" line list))))
-	 (else alist))))))
-
-(run 
- '(define (read-libtool-la file-name)
-    (call-with-input-file
-	file-name
-      (lambda (port)
-	(let lp ((line (read-line port)) (alist '()))
-	  (if (eof-object? line)
-	      alist
-	      (lp (read-line port) (add-la-entry line alist))))))))
-
-(run '(let* ((lib-dir (string-append "@yplibdir@/" @yphost@))
-	     (la-file-name (string-append lib-dir "/libscshyp.la"))
-	     (initializer-name "scsh_yp_main"))
-	(let ((la-alist (read-libtool-la la-file-name)))
-	  (cond 
-	   ((assoc 'dlname la-alist)
-	    => (lambda (p)
-		 (dynamic-load (string-append lib-dir "/" (cdr p)))
-		 (call-external (get-external initializer-name))))
-	   (else
-	    (error "Could not figure out libscshyp's name" la-file-name))))))
-
-(run '(let ((lib-dir (string-append "@scxlibdir@/" @scxhost@))
-	    (la-file-name (string-append lib-dir "/libscx.la"))
-	    (initializer-name "scx_init_xlib"))
-	(let ((la-alist (read-libtool-la la-file-name)))
-	  (cond
-	   ((assoc 'dlname la-alist)
-	    => (lambda (p)
-		 (let ((module-file (string-append lib-dir "/" (cdr p))))
-		   (dynamic-load module-file)
-		   (call-external (get-external initializer-name))
-		   (if (string=? "@scxload_xft_packages@" "yes")
-		       (begin
-			 (call-external (get-external "scx_xft_init"))
-			 (call-external (get-external "scx_xrender_init")))))))
-	   (else
-	    (error "Could not figure out libscx's name" la-file-name))))))
-
-(config)
-(load "@scxschemedir@/xlib/xlib-interfaces.scm")
-(load "@scxschemedir@/xlib/xlib-packages.scm")
-(load "@scxschemedir@/libs/libs-interfaces.scm")
-(load "@scxschemedir@/libs/libs-packages.scm")
-(user)
-
diff --git a/pkg-def.scm b/pkg-def.scm
index be0bea9..fadbf92 100644
--- a/pkg-def.scm
+++ b/pkg-def.scm
@@ -24,27 +24,40 @@
 		       (zero? (run ,make))))
 	     (exit))))
 
-  ;; create load.scm with sed, this is platform-independent
-  (if (not (get-option-value 'non-shared-only))
-      (begin
-	(display "creating load.scm\n")
-	(let ((schemedir (get-directory 'scheme #f))
-	      (libdir (get-directory 'lib #f))
-	      (load-xft-packages (if (get-option-value 'with-xft) "yes" "no"))
-	      (target-dir (get-directory 'base #t))
-	      (sed-replace (lambda (from to)
-			     (string-append "s|" from "|" to "|g"))))
-	  (let ((cmd `(sed -e ,(sed-replace "@scxschemedir@" schemedir)
-			   -e ,(sed-replace "@scxhost@" "(host)")
-			   -e ,(sed-replace "@scxlibdir@" libdir)
-			   -e ,(sed-replace "@scxload_xft_packages@"
-					    load-xft-packages)
-			   "load.scm.in"))
-		(tgt (string-append target-dir "/load.scm")))
-	    (if (get-option-value 'dry-run)
-		(begin (display cmd) (display " > ") (display tgt) (newline))
-		(if (not (zero? (run ,cmd (> ,tgt))))
-		    (exit)))))))
+  ;; create load.scm
+  (let ((schemedir (get-directory 'scheme #f))
+	(libdir (get-directory 'lib #f))
+	(load-xft-packages (get-option-value 'with-xft)))
+    (write-to-load-script
+     `((user)
+       (load-package 'dynamic-externals)
+       (open 'dynamic-externals)
+       (open 'external-calls)
+       (open 'configure)
+       (open 'signals)
+       ,@(map (lambda (x) `(run ',x)) tmpl-libtool-la-reader)
+       (run '(let* ((lib-dir (string-append ,libdir "/" (host)))
+		    (la-file-name (string-append lib-dir "/libscx.la"))
+		    (initializer-name "scx_init_xlib"))
+	       (let ((la-alist (read-libtool-la la-file-name)))
+		 (cond
+		  ((assoc 'dlname la-alist)
+		   => (lambda (p)
+			(let ((module-file (string-append lib-dir "/" (cdr p))))
+			  (dynamic-load module-file)
+			  (call-external (get-external initializer-name))
+			  ,(if load-xft-packages
+			       '(begin
+				  (call-external (get-external "scx_xft_init"))
+				  (call-external (get-external "scx_xrender_init")))))))
+		  (else
+		   (error "Could not figure out libscx's name" la-file-name))))))
+       (config)
+       (load ,(string-append schemedir "/xlib/xlib-interfaces.scm"))
+       (load ,(string-append schemedir "/xlib/xlib-packages.scm"))
+       (load ,(string-append schemedir "/libs/libs-interfaces.scm"))
+       (load ,(string-append schemedir "/libs/libs-packages.scm"))
+       (user))))
 
   (install-directory-contents "scheme" 'scheme)
 )