@@ -21,208 +21,5 @@ (declare (uses common)) (declare (uses commonmod)) (import commonmod) -(define ods:dirs - '("Configurations2" - "Configurations2/toolpanel" - "Configurations2/menubar" - "Configurations2/toolbar" - "Configurations2/progressbar" - "Configurations2/floater" - "Configurations2/images" - "Configurations2/images/Bitmaps" - "Configurations2/statusbar" - "Configurations2/popupmenu" - "Configurations2/accelerator" - "META-INF" - "Thumbnails")) - -(define ods:0-len-files - '("Configurations2/accelerator/current.xml" - ;; "Thumbnails/thumbnail.png" - "content.xml" - )) - -(define ods:files - '(("META-INF/manifest.xml" - ("\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n")) - ("styles.xml" - ("\n" - "$-$???Page 1??? (???)09/06/2011, 20:48:51Page 1 / 99\n")) - ("settings.xml" - ("\n" - "0045161799view100000020000010060true04000020000010060trueSheet2270010060falsetruetruetrue12632256truetruetruetruefalsefalse1270127011truefalsetrue3falsetruetruetrue12701270false1truetrue1true12632256falsefalsetrue0truetruetruefalsetrue\n")) - ("mimetype" - ("application/vnd.oasis.opendocument.spreadsheet")) - ("meta.xml" - ("\n" - "Matt Welland2011-09-06T20:46:232011-09-06T20:48:51Matt WellandPT2M29S1LibreOffice/3.3$Linux LibreOffice_project/330m19$Build-301\n")))) - -(define ods:content-header - '("\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n" - "\n")) - -(define ods:content-footer - '("\n" - "\n" - "\n")) - -(define (ods:make-thumbnail path) - (let ((oup (open-output-pipe (conc "uudecode -o " path "/Thumbnails/thumbnail.png")))) - (with-output-to-port oup - (lambda () - (print "begin-base64 640 Thumbnail.png -iVBORw0KGgoAAAANSUhEUgAAAL4AAAEACAIAAACCoVt7AAAEWElEQVR4nO3X -MU4bWQCA4bGUo5gUKCcgJwCaVNvShdI06VKmSxNKp6PdKg3xCcgJIhr7Ll6P -DTgBRbv5i11W+r7Gw7yZx0jv5415sV6vB/h9L/7rB+D/apfO4nxy8nk8OPq0 -vDm9Pr8+nc+mv75pcXl5MNtfsLp8fXDxbRjefl3Pj//xb340yW+N8gyM6awu -vxwu1+txnVar1Xj2z7PJpoUxhYNdFmNSs+EukdHRcHpzt7Kr69s/luub6Wa1 -V8Px9tx9TLsSH2a4OxwjWx5+uLgYhtOr4ezXo8Ori4tt0b8XJf+KMZ3p7N3w -ejIZV227hMP3V+/XNweX59erxZddK98uPi5eDvfdbC672u8I09l8tvlYDC/v -z93HNJa4+Hj7fr0+3mxs54vTw1e7BM+vh9n7T8PBbPlx8jD/k9HT4WzsRzfP -0/aFtVi+vNl9W75b4MODhwv2C7c4vz/e7C8/zzK+8Iav6ycLPJ1Ol3/zAPv5 -N5vfo7tnN+vZuIFNJvJ5frYvrOHLh8nJyfjjuOsM1/slPH53uNmPTnYDD8dH -R5ut4uGFdf9F6WQy3C3wdPbmdjKZDNsw7u56PPMw3F6cXS6vDs/u57/66cE2 -o+e3w+fP203p7RvdPDvbF9bx/GY935/bvYDuPsa//IeBH473jufrH+9+cu54 -f9dPM893u9QPcz4dnT+emGfDP+dE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6R -dIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i -6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE -0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSI -pEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQ -SYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIh -kg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRD -JB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmH -SDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIO -kXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQd -IukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6 -RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0 -iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLp -EEmHSDpE0iGSDpF0iKRDJB0i6RBJh+gv8TgE/jVPQbMAAAAASUVORK5CYII= -===="))))) - -;; sheetdat is '("sheetname" (r1c1 r2c2 ...)(r2c1 r2c2 ...) ...) -(define (ods:sheet sheetdat) - (let ((name (car sheetdat)) - (rows (cdr sheetdat))) - (conc "\n" - (conc (ods:column) - (string-join (map ods:row rows) "")) - ""))) - -;; seems to be called once at top of each sheet, i.e. a column of rows -(define (ods:column) - "\n") - -;; cells is a list of ... -(define (ods:row cells) - (conc "\n" - (string-join (map ods:cell cells) "") - "\n")) - -;; types are "string" or "float" -(define (ods:cell value) - (let* ((type (cond - ((string? value) "string") - ((symbol? value) "string") - ((number? value) "float") - (else #f))) - (tmpval (if (symbol? value) - (symbol->string value) - (if type value ""))) ;; convert everything else to an empty string - (escval (if (string? tmpval)(string-substitute (regexp "<") "<" (string-substitute (regexp ">") ">" tmpval)) tmpval))) - (conc "\n" - "" escval "" "\n" - "" "\n"))) - -;; create the directories -(define (ods:construct-dir path) - (for-each - (lambda (subdir) - (system (conc "mkdir -p " path "/" subdir))) - ods:dirs)) - -;; populate the necessary, non-constructed, files -(define (ods:add-non-content-files path) - ;; first the zero-length files, nb// the dir should already be created - (for-each - (lambda (fname) - (system (conc "touch " path "/" fname))) - ods:0-len-files) - ;; create the files with stuff in them - (for-each - (lambda (fdat) - (let* ((name (car fdat)) - (lines (cadr fdat))) - (with-output-to-file (conc path "/" name) - (lambda () - (for-each - (lambda (line) - (display line)) - lines))))) - ods:files)) - -;; data format: -;; '( (sheet1 (r1c1 r1c2 r1c3 ...) -;; (r2c1 r2c3 r2c3 ...) ) -;; (sheet2 ( ... ) -;; ( ... ) ) ) -(define (ods:list->ods path fname data) - (if (not (common:file-exists? path)) - (print "ERROR: path to create ods data must pre-exist") - (begin - (with-output-to-file (conc path "/content.xml") - (lambda () - (ods:construct-dir path) - (ods:add-non-content-files path) - (ods:make-thumbnail path) - (map display ods:content-header) - ;; process each sheet - (map print - (map ods:sheet data)) - (map display ods:content-footer))) - (system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype` > /dev/null"))))) -