Megatest

Diff
Login

Differences From Artifact [0f900c77cf]:

To Artifact [1a2ebfec3c]:


124
125
126
127
128
129
130

131
132
133
134







135
136
137
138
139
140
141

142
143

144

145
146
147
148


149
150
151
152
153




154
155
156
157
158
159
160
124
125
126
127
128
129
130
131




132
133
134
135
136
137
138
139
140
141
142
143
144

145
146
147
148

149
150
151


152
153





154
155
156
157
158
159
160
161
162
163
164







+
-
-
-
-
+
+
+
+
+
+
+






-
+


+
-
+


-
-
+
+
-
-
-
-
-
+
+
+
+







kXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQd
IukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6
RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0
iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLp
EEmHSDpE0iGSDpF0iKRDJB0i6RBJh+gv8TgE/jVPQbMAAAAASUVORK5CYII=
====")))))

;; sheetdat is '("sheetname" (r1c1 r2c2 ...)(r2c1 r2c2 ...) ...)
(define (ods:sheet sheetname content)
  (conc "<table:table table:name=\"" sheetname "\" table:style-name=\"ta1\" table:print=\"false\">\n"
	content
	"</table:table>\n"))
(define (ods:sheet sheetdat)
  (let ((name (car sheetdat))
	(rows (cdr sheetdat)))
    (conc "<table:table table:name=\"" name "\" table:style-name=\"ta1\" table:print=\"false\">\n"
	  (conc (ods:column)
		(apply conc (map ods:row rows)))
	  "</table:table>")))

;; seems to be called once at top of each sheet, i.e. a column of rows
(define (ods:column)
  "<table:table-column table:style-name=\"co1\" table:number-columns-repeated=\"2\" table:default-cell-style-name=\"Default\"/>\n")

;; cells is a list of <table:table-cell ..> ... </table:table-cell>
(define (ods:row . cells)
(define (ods:row cells)
  (apply conc
	 (cons "<table:table-row table:style-name=\"ro1\">\n"
	       (append (map ods:cell cells)
	       (append cells (list "</table:table-row>\n")))))
		       (list "</table:table-row>\n")))))

;; types are "string" or "float"
(define (ods:cell value . params)
  (let ((type (if (not (null? params))
(define (ods:cell value)
  (let ((type (cond
		  (car params)
		  (cond
		   ((string? value) "string")
		   ((number? value) "float")
		   (else "string")))))
	       ((string? value) "string")
	       ((symbol? value) "string")
	       ((number? value) "float")
	       (else "string"))))
    (conc "<table:table-cell office:value-type=\"" type "\">" "\n"
	  "<text:p>" value "</text:p>" "\n"
	  "</table:table-cell>" "\n")))

;; create the directories
(define (ods:construct-dir path)
  (for-each 
174
175
176
177
178
179
180
181

182
183
184
185
186
187

188
189
190
191
192
193
194
195
196
197
198
199

200
201


202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219

178
179
180
181
182
183
184

185
186
187
188
189
190

191
192
193
194
195
196
197
198
199
200
201
202
203
204


205
206















207
208

209







-
+





-
+












+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+
   (lambda (fdat)
     (let* ((name  (car fdat))
	    (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 ...) 
;;              (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
	    (print 
	     (ods:sheet 
	    (map print 
		 (map ods:sheet data))
	      "Sheet1"
	      (conc
	       (ods:column)
	       (ods:row
		(ods:cell "Row 1,A")
		(ods:cell "Row 1,B"))
	       (ods:row
		(ods:cell "Row 2,A")
		(ods:cell "Row 2,B"))))
	     (ods:sheet
	      "Sheet2"
	      (conc
	       (ods:column)
	       (ods:row
		(ods:cell "Sheet 2 contents")))))
	    (map display ods:content-footer)))
	(system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype`")))))