Rewrote export-directory to support automatic generation of directory

index-redirectors, fixed lambda-list to use keyword arguments, and
added support for user-selectable entity-class.

src/main/utility.cl

@@ -26,11 +26,22 @@ file-entity."
      :entity
      (make-instance 'file-entity :content-type type :pathname file))))
 
-(defun export-directory (server type-map base directory &optional recursive-p)
+(defun export-directory
-  "Export the contents of a directory."
+    (server type-map base directory
+	    &key (entity-class 'file-entity) recursive-p index-redir-p)
+  "Export the contents of a directory(-tree)."
   (flet ((lookup-type (type)
 	   (or (cdr (assoc type type-map :test #'equal))
 	       (cdr (assoc t type-map :test #'equal)))))
+    (when index-redir-p
+      (export-resource server base 'redirector-resource
+		       :destination
+		       (merge-urls
+			(if (eq index-redir-p t)
+			    (make-instance 'url-http :scheme nil
+					   :name "index.html")
+			    index-redir-p)
+			base)))
     (dolist (file (directory directory))
       (if (null (pathname-name file))
 	  (when recursive-p
@@ -38,21 +49,22 @@ file-entity."
 	     server type-map
 	     (merge-urls
 	      (make-instance
-	       'url-http
+	       'url-http :scheme nil
 	       :directory (list* :relative (last (pathname-directory file))))
 	      base)
 	     file
-	     recursive-p))
+	     :entity-class entity-class :index-redir-p index-redir-p
+	     :recursive-p t))
 	  (export-resource
 	   server
 	   (merge-urls
-	    (make-instance 'url-http :name
+	    (make-instance 'url-http :scheme nil :name
 			   (concatenate 'string (pathname-name file)
 					"." (pathname-type file)))
 	    base)
 	   'static-resource
 	   :entity
-	   (make-instance 'file-entity
+	   (make-instance entity-class
 			  :content-type (lookup-type (pathname-type file))
 			  :pathname file))))))