ffi/build: Fix add/remove-plugin handling of compressed files.

diff --git a/src/ffi/build.scm b/src/ffi/build.scm
index d823c14d568114709152dde8538600206ec3a4f3..099d3fcf0fab7ec5bfedf5f1718f54ec64a71479 100644 (file)
--- a/src/ffi/build.scm
+++ b/src/ffi/build.scm
@@ -34,21 +34,21 @@ USA.
   (update-plugin 'remove name project infodir scmlibdir scmdocdir))
 
 (define (update-plugin operation name project infodir scmlibdir scmdocdir)
-  (let ((scmlibdir (pathname-as-directory scmlibdir))
+  (let ((scmlibdir (->namestring (pathname-as-directory scmlibdir)))
        (infodir (and (not (string-null? infodir))
-                     (pathname-as-directory infodir)))
+                     (->namestring (pathname-as-directory infodir))))
        (scmdocdir (and (not (string-null? scmdocdir))
-                       (pathname-as-directory scmdocdir))))
+                       (->namestring (pathname-as-directory scmdocdir)))))
     (let ((plugins (updated-plugin-list operation name scmlibdir)))
       (update-optiondb plugins scmlibdir)
       (update-info-index project plugins infodir scmdocdir)
       (update-html-index plugins scmdocdir))))
 
 (define (updated-plugin-list operation plugin scmlibdir)
-  (let ((pathname (merge-pathnames "plugins.scm" scmlibdir)))
-    (if (file-exists? pathname)         ;i.e. NOT in dpkg-buildpackage chroot
+  (let ((filename (string scmlibdir"/plugins.scm")))
+    (if (file-exists? filename)         ;i.e. NOT in dpkg-buildpackage chroot
        (rewrite-file
-        pathname
+        filename
         (lambda (in out)
           (cond ((eq? operation 'add)
                  (let ((new (cons plugin (delete! plugin (read in)))))
@@ -61,14 +61,14 @@ USA.
                 (else
                  (error "Unexpected plugin-list operation:" operation)))))
        (begin
-         (warn "plugin list not found:" pathname)
+         (warn "plugin list not found:" filename)
          '()))))
 
 (define (update-optiondb plugins scmlibdir)
-  (let ((pathname (merge-pathnames "optiondb.scm" scmlibdir)))
-    (if (file-exists? pathname)                ;i.e. NOT in dpkg-buildpackage chroot
+  (let ((filename (string scmlibdir"/optiondb.scm")))
+    (if (file-exists? filename)                ;i.e. NOT in dpkg-buildpackage chroot
        (rewrite-file
-        pathname
+        filename
         (lambda (in out)
           (copy-to+line "(further-load-options" in out)
           (write-string (string ";;; DO NOT EDIT the remainder of this file."
@@ -82,23 +82,21 @@ USA.
               (write-string name out)
               (write-string "\"))\n" out))
             (sort plugins string<?))))
-       (warn "optiondb not found:" pathname))))
+       (warn "optiondb not found:" filename))))
 
 (define (update-info-index project plugins infodir scmdocdir)
-  (let ((pathname (and infodir
-                      (merge-pathnames (string project".info") infodir))))
-    (if (and pathname
-            (file-exists-or-compressed? pathname))
+  (let ((filename (and infodir (string infodir"/"project".info"))))
+    (if (and filename (file-exists-or-compressed? filename))
        (rewrite-file
-        pathname
+        filename
         (lambda (in out)
           (copy-to+line "Plugin Manuals" in out)
           (newline out)
           (for-each (lambda (plugin)
                       (write-direntry project plugin scmdocdir out))
                     (sort plugins string<?))))
-       (if pathname
-           (warn "Scheme Info index not found:" pathname)))))
+       (if filename
+           (warn "Scheme Info index not found:" filename)))))
 
 (define (write-direntry project plugin scmdocdir out)
   (load-option-quietly 'regular-expression)
@@ -121,11 +119,11 @@ USA.
                      line))))))))))
 
 (define (update-html-index plugins scmdocdir)
-  (let* ((scmhtmldir (merge-pathnames "html/" scmdocdir))
-        (pathname (merge-pathnames "index.html" scmhtmldir)))
-    (if (file-exists? pathname)
+  (let* ((scmhtmldir (string scmdocdir"/html"))
+        (filename (string scmhtmldir"/index.html")))
+    (if (file-exists? filename)
        (rewrite-file
-        pathname
+        filename
         (lambda (in out)
           (copy-to+line "<ul id=\"plugins\"" in out)
           (newline out)
@@ -161,26 +159,24 @@ USA.
               ((eof-object? line))
             (write-string line out)
             (newline out))))
-       (warn "Scheme html index not found:" pathname))))
+       (warn "Scheme html index not found:" filename))))
 
 (define (html-names.titles plugins scmhtmldir)
-  (let ((base (pathname-new-type (merge-pathnames scmhtmldir) "html")))
-    (append-map!
-     (lambda (plugin)
-       (let ((pathname (merge-pathnames plugin base)))
-        (if (file-exists? pathname)
-            (list (cons plugin (read-html-title pathname)))
-            '())))
-     plugins)))
-
-(define (read-html-title pathname)
+  (append-map! (lambda (plugin)
+                (let ((filename (string scmhtmldir"/"plugin".html")))
+                  (if (file-exists? filename)
+                      (list (cons plugin (read-html-title filename)))
+                      '())))
+              plugins))
+
+(define (read-html-title filename)
   (load-option-quietly 'regular-expression)
-  (call-with-input-file pathname
+  (call-with-input-file filename
     (lambda (in)
       (let loop ()
        (let ((line (read-line in)))
          (if (eof-object? line)
-             (error "Could not find HTML title:" pathname)
+             (error "Could not find HTML title:" filename)
              (let ((regs (re-string-match "<title>\\(.*\\)</title>" line)))
                (if (not regs)
                    (loop)
@@ -273,18 +269,18 @@ USA.
     ("bz2" "bzip2" . "bunzip2")
     ("Z" "compress" . "uncompress")))
 
-(define (file-exists-or-compressed? pathname)
-  (or (file-exists? pathname)
-      (let ((filename (->namestring pathname)))
-       (find (lambda (suffix.progs)
-               (file-exists? (string filename"."(car suffix.progs))))
-             compressed-file-suffixes.progs))))
+(define (file-exists-or-compressed? filename)
+  (or (file-exists? filename)
+      (find-compressed-suffix.progs filename)))
 
 (define (compressed? filename)
   (and (not (file-exists? filename))
-       (find (lambda (suffix.progs)
-              (file-exists? (string filename"."(car suffix.progs))))
-            compressed-file-suffixes.progs)))
+       (find-compressed-suffix.progs filename)))
+
+(define (find-compressed-suffix.progs filename)
+  (find (lambda (suffix.progs)
+         (file-exists? (string filename"."(car suffix.progs))))
+       compressed-file-suffixes.progs))
 
 (define (un/compress-file program infile outfile)
   (let ((cmdline (string program" < '"infile"' > '"outfile"'")))