Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -372,11 +372,14 @@ (let ((s (vector-ref x 2))) (if (number? s)(seconds->time-string s) s)) (vector-ref x 3) (vector-ref x 4))) (sort (hash-table-values comprsteps) - (lambda (a b)(< (vector-ref a 1)(vector-ref b 1)))))) + (lambda (a b) + (if (and (number? a)(number? b)) + (< (vector-ref a 1)(vector-ref b 1)) + #t))))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! stepsdat "TITLE" newval))))) stepsdat))))) (iup:show self) Index: ods.scm ================================================================== --- ods.scm +++ ods.scm @@ -3,11 +3,13 @@ ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -;; PURPOSE. +;; PURPOSE + +(use csv-xml) (define ods:dirs '("Configurations2" "Configurations2/toolpanel" "Configurations2/menubar" @@ -28,93 +30,136 @@ "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" - ("" - "$-$???Page 1??? (???)09/06/2011, 20:48:51Page 1 / 99")) + ("\n" + "$-$???Page 1??? (???)09/06/2011, 20:48:51Page 1 / 99\n")) ("settings.xml" - ("" - "0045161799view100000020000010060true04000020000010060trueSheet2270010060falsetruetruetrue12632256truetruetruetruefalsefalse1270127011truefalsetrue3falsetruetruetrue12701270false1truetrue1true12632256falsefalsetrue0truetruetruefalsetrue")) + ("\n" + "0045161799view100000020000010060true04000020000010060trueSheet2270010060falsetruetruetrue12632256truetruetruetruefalsefalse1270127011truefalsetrue3falsetruetruetrue12701270false1truetrue1true12632256falsefalsetrue0truetruetruefalsetrue\n")) ("mimetype" ("application/vnd.oasis.opendocument.spreadsheet")) ("meta.xml" - ("" - "Matt Welland2011-09-06T20:46:232011-09-06T20:48:51Matt WellandPT2M29S1LibreOffice/3.3$Linux LibreOffice_project/330m19$Build-301")))) + ("\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 - '("" - "" - "" - "")) - -(define (ods:sheet sheetname content) - (conc "" - content - "")) + '("\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) + (apply conc (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) (apply conc - (cons "" - (append cells (list ""))))) + (cons "\n" + (append (map ods:cell cells) + (list "\n"))))) ;; types are "string" or "float" -(define (ods:cell value type) - (conc "" - "" value "" - "")) +(define (ods:cell value) + (let ((type (cond + ((string? value) "string") + ((symbol? value) "string") + ((number? value) "float") + (else "string")))) + (conc "" "\n" + "" value "" "\n" + "" "\n"))) ;; create the directories (define (ods:construct-dir path) (for-each (lambda (subdir) @@ -135,12 +180,30 @@ (lines (cadr fdat))) (with-output-to-file (conc path "/" name) (lambda () (for-each (lambda (line) - (print 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 (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`"))))) - -