Megatest

Check-in [45f101f990]
Login
Overview
Comment:Added simple ods writer
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | ods-writer
Files: files | file ages | folders
SHA1: 45f101f990e2bcd5028c39c7811f9b9cecbe8d43
User & Date: mrwellan on 2011-09-07 21:35:01
Other Links: branch diff | manifest | tags
Context
2011-09-07
21:35
Added simple ods writer Closed-Leaf check-in: 45f101f990 user: mrwellan tags: ods-writer (unpublished)
14:27
Basic ods document generation working Closed-Leaf check-in: 9339ec910b user: mrwellan tags: spreadsheet (unpublished)
Changes

Modified dashboard-tests.scm from [5627038660] to [41c37aec4d].

370
371
372
373
374
375
376


377

378
379
380
381
382
383
384
											   (let ((s (vector-ref x 1)))
											     (if (number? s)(seconds->time-string s) s))
											   (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))))))

									   "\n")))
							    (if (not (equal? currval newval))
								(iup:attribute-set! stepsdat "TITLE" newval)))))
		  stepsdat)))))
      (iup:show self)
      (iup:callback-set! *tim* "ACTION_CB"
			 (lambda (x)







>
>
|
>







370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
											   (let ((s (vector-ref x 1)))
											     (if (number? s)(seconds->time-string s) s))
											   (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)
											 (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)
      (iup:callback-set! *tim* "ACTION_CB"
			 (lambda (x)

Modified ods.scm from [0f900c77cf] to [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
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`")))))