ffi: Add delete-plugin-list and update-plugin-indices

for the Debian install/uninstall scripts.

diff --git a/src/ffi/build.scm b/src/ffi/build.scm
index dd3a79d516ca3b3d9d490e78f88605a18e74014f..4c51d4fc7e889c13e3eea69263d8414e42f89c88 100644 (file)
--- a/src/ffi/build.scm
+++ b/src/ffi/build.scm
@@ -28,9 +28,11 @@ USA.
 ;;; package: (ffi build)
 
 (define (add-plugin name project infodir scmlibdir scmdocdir)
+  ;; For plugin postinst scripts: register.
   (update-plugin 'add name project infodir scmlibdir scmdocdir))
 
 (define (remove-plugin name project infodir scmlibdir scmdocdir)
+  ;; For plugin prerm scripts: de-register.
   (update-plugin 'remove name project infodir scmlibdir scmdocdir))
 
 (define (update-plugin operation name project infodir scmlibdir scmdocdir)
@@ -39,30 +41,68 @@ USA.
                      (->namestring (pathname-as-directory infodir))))
        (scmdocdir (and (not (string-null? 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 ((filename (string scmlibdir"plugins.scm")))
-    (if (file-exists? filename)         ;i.e. NOT in dpkg-buildpackage chroot
-       (rewrite-file
-        filename
-        (lambda (in out)
-          (cond ((eq? operation 'add)
-                 (let ((new (cons plugin (delete! plugin (read in)))))
-                   (write new out)
-                   new))
-                ((eq? operation 'remove)
-                 (let ((new (delete! plugin (read in))))
-                   (write new out)
-                   new))
-                (else
-                 (error "Unexpected plugin-list operation:" operation)))))
-       (begin
-         (warn "plugin list not found:" filename)
-         '()))))
+    (if (file-exists? (string scmlibdir"optiondb.scm"))
+       ;; NOT in dpkg-buildpackage's chroot
+       (let ((plugins
+              (let ((filename (string scmlibdir"plugins.scm")))
+                (if (file-exists? filename)
+                    (rewrite-file
+                     filename
+                     (lambda (in out)
+                       (cond ((eq? operation 'add)
+                              (let ((new (cons name
+                                               (delete! name (read in)))))
+                                (write new out)
+                                new))
+                             ((eq? operation 'remove)
+                              (let ((new (delete! name (read in))))
+                                (write new out)
+                                new))
+                             (else
+                              (error "Unexpected plugin-list operation:"
+                                     operation)))))
+                    (cond ((eq? operation 'add)
+                           (let ((new (list name)))
+                             (call-with-exclusive-output-file
+                              filename
+                              (lambda (out) (write new out)))
+                             new))
+                          ((eq? operation 'remove)
+                           (warn "plugin list not found:" filename)
+                           '())
+                          (else
+                           (error "Unexpected plugin-list operation:"
+                                  operation)))))))
+         (update-optiondb plugins scmlibdir)
+         (update-info-index project plugins infodir scmdocdir)
+         (update-html-index plugins scmdocdir)))))
+
+(define (delete-plugin-list)
+  ;; For the prerm script: delete the database of plugins (plugins.scm
+  ;; file in the system library directory).
+  (let ((filename (string (->namestring (system-library-directory-pathname))
+                         "plugins.scm")))
+    (if (file-exists? filename)
+       (delete-file filename))))
+
+(define (update-plugin-indices project infodir scmlibdir scmdocdir)
+  ;; For the postinst script: re-initialize the optiondb, Info and
+  ;; HTML indices using the list of currently installed plugins.  (The
+  ;; indices are presumed clobbered by the core upgrade.)
+  (let ((scmlibdir (->namestring (pathname-as-directory scmlibdir)))
+       (infodir (and (not (string-null? infodir))
+                     (->namestring (pathname-as-directory infodir))))
+       (scmdocdir (and (not (string-null? scmdocdir))
+                       (->namestring (pathname-as-directory scmdocdir)))))
+    (let* ((pathname (string scmlibdir"plugins.scm"))
+          (plugins (if (file-exists? pathname)
+                       (call-with-input-file pathname read)
+                       '())))
+      (if (not (null? plugins))
+         (begin
+           (update-optiondb plugins scmlibdir)
+           (update-info-index project plugins infodir scmdocdir)
+           (update-html-index plugins scmdocdir))))))
 
 (define (update-optiondb plugins scmlibdir)
   (let ((filename (string scmlibdir"optiondb.scm")))
@@ -133,7 +173,9 @@ USA.
                                        "\n") out)
 
           ;; Write new list.
-          (let ((names.titles (html-names.titles plugins scmhtmldir)))
+          (let ((names.titles (sort (html-names.titles plugins scmhtmldir)
+                                    (lambda (a b)
+                                      (string<? (cdr a) (cdr b))))))
             (for-each
               (lambda (name.title)
                 (write-string "<li><a href=\"" out)

diff --git a/src/ffi/ffi.pkg b/src/ffi/ffi.pkg
index 7bc6362b7cfee5b5f0af15ab84a22ebb1935acf3..8ccdf0c7559ff2035fd50ce7b03bf24a6395c1d6 100644 (file)
--- a/src/ffi/ffi.pkg
+++ b/src/ffi/ffi.pkg
@@ -42,4 +42,6 @@ FFI System Packaging |#
   (files "build")
   (export (ffi)
          add-plugin
-         remove-plugin))
\ No newline at end of file
+         remove-plugin
+         delete-plugin-list
+         update-plugin-indices))
\ No newline at end of file

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 4c5dd86892c1ca3e3d4ea7ad84d3c4fd9d2388a1..3f0fda933ed539a6aa1f32a1520e50dae1f7ac6e 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -608,6 +608,15 @@ USA.
   ((environment-lookup (->environment '(ffi)) 'remove-plugin)
    name project infodir scmlibdir scmdocdir))
 
+(define (delete-plugin-list)
+  (load-option-quietly 'ffi)
+  ((environment-lookup (->environment '(ffi)) 'delete-plugin-list)))
+
+(define (update-plugin-indices project infodir scmlibdir scmdocdir)
+  (load-option-quietly 'ffi)
+  ((environment-lookup (->environment '(ffi)) 'update-plugin-indices)
+   project infodir scmlibdir scmdocdir))
+
 (define (load-option-quietly name)
   (if (not (option-loaded? name))
       (let ((kernel