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
|
kXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQd
IukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6
RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0
iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLp
EEmHSDpE0iGSDpF0iKRDJB0i6RBJh+gv8TgE/jVPQbMAAAAASUVORK5CYII=
====")))))
(define (ods:sheet sheetname content)
(conc "<table:table table:name=\"" sheetname "\" table:style-name=\"ta1\" table:print=\"false\">\n"
content
"</table:table>\n"))
;; 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)
(apply conc
(cons "<table:table-row table:style-name=\"ro1\">\n"
(append cells (list "</table:table-row>\n")))))
;; types are "string" or "float"
(define (ods:cell value . params)
(let ((type (if (not (null? params))
(car params)
(cond
((string? 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
|
>
|
>
>
|
|
>
|
|
>
|
|
|
<
<
|
>
|
|
|
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 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)
(apply conc
(cons "<table:table-row table:style-name=\"ro1\">\n"
(append (map ods:cell cells)
(list "</table:table-row>\n")))))
;; types are "string" or "float"
(define (ods:cell value)
(let ((type (cond
((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
|
(lambda (fdat)
(let* ((name (car fdat))
(lines (cadr fdat)))
(with-output-to-file (conc path "/" name)
(lambda ()
(for-each
(lambda (line)
(print 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)
(print
(ods:sheet
"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`")))))
|
|
|
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
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)
(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`")))))
|