Refdb

Check-in [1da5afe233]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added support for creating non-existing sheets
Timelines: family | ancestors | descendants | both | v1.01
Files: files | file ages | folders
SHA1:1da5afe2337fb8d3a7ce27d645770b45b4b98e6b
User & Date: mrwellan 2014-08-12 16:05:47
Context
2014-08-12
16:35
Added missing file check-in: 49adb74cc4 user: mrwellan tags: v1.01
16:05
Added support for creating non-existing sheets check-in: 1da5afe233 user: mrwellan tags: v1.01
15:34
Added auto-creation of sheet sxml file if not existing check-in: 6bb4196217 user: mrwellan tags: v1.01
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to refdb-module.scm.

260
261
262
263
264
265
266
267









268
269
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323

324
325
326
327
328
329
330

(define (hash-table-reverse-lookup ht val)
  (hash-table-fold ht (lambda (k v res)(if (equal? v val) k res)) #f))

(define (transpose-dat dat)
  (map (lambda (el)(list (cadr el)(car el)(caddr el)))
       dat))










;; converge this with the ini-file egg and the Megatest config reader. 
;;
(define (read-dat fname #!key (record 'col)) ;; record 'col or 'row

  (let ((section-rx  (regexp "^\\[(.*)\\]\\s*$"))
	(comment-rx  (regexp "^#.*"))          ;; This means a cell name cannot start with #
	(quoted-cell-rx (regexp "^\"([^\"]*)\" (.*)$"))
	(cell-rx     (regexp "^(\\S+) (.*)$")) ;; One space only for the cellname content separator 
	(blank-rx    (regexp "^\\s*$"))
	(continue-rx (regexp ".*\\\\$"))
	(var-no-val-rx (regexp "^(\\S+)\\s*$"))
	(inp         (open-input-file fname))
	(cmnt-indx   (make-hash-table))
	(blnk-indx   (make-hash-table))
	(first-section "")) ;; used for zeroth title
    (let loop ((inl     (read-line inp))
	       (section ".............")
	       (res     '()))
      (if (eof-object? inl)
	  (begin
	    (close-input-port inp)
	    (let ((newres (cons (list first-section first-section first-section)
				(reverse res))))
	      (if (eq? record 'col)
		  newres
		  (transpose-dat newres))))
	  (regex-case
	   inl 
	   (continue-rx _         (loop (conc inl (read-line inp)) section res))
	   (comment-rx _          (let ((curr-indx (+ 1 (hash-table-ref/default cmnt-indx section 0))))
				    (hash-table-set! cmnt-indx section curr-indx)
				    (loop (read-line inp)
					  section 
					  (cons (list (conc "#CMNT" curr-indx) section inl) res))))
	   (blank-rx   _          (let ((curr-indx (+ 1 (hash-table-ref/default blnk-indx section 0))))
				    (hash-table-set! blnk-indx section curr-indx)
				    (loop (read-line inp)
					  section
					  (cons (list (conc "#BLNK" curr-indx) section " ") res))))
	   (section-rx (x sname)  (begin
				    (if (not first-section)
					(set! first-section sname))
				    (loop (read-line inp) 
					  sname 
					  res)))
	   (quoted-cell-rx (x k v)(loop (read-line inp)
					section
					(cons (list k section v) res)))
	   (cell-rx   (x k v)     (loop (read-line inp)
					section
					(cons (list k section v) res)))
	   (var-no-val-rx (x k)   (loop (read-line inp)
					section
					(cons (list k section "") res)))
	   (else                  (begin
				    (print "ERROR: Unrecognised line in input file " fname ", ignoring it")
				    (loop (read-line inp) section res))))))))


(define (dat-lookup dat section var)
  (let ((res (assoc section (map cdr (filter (lambda (x)(equal? (car x) var)) dat)))))
    (if res
	(cadr res)
	#f)))









>
>
>
>
>
>
>
>
>



>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

(define (hash-table-reverse-lookup ht val)
  (hash-table-fold ht (lambda (k v res)(if (equal? v val) k res)) #f))

(define (transpose-dat dat)
  (map (lambda (el)(list (cadr el)(car el)(caddr el)))
       dat))

(define (create-empty-dat fname)
  (if (not (file-exists? fname))
      (if (file-write-access? (pathname-directory fname))
	  (with-output-to-file fname
	    (lambda ()
	      (print "[Refdb data file]\nfield value ...")))
	  #f)
      #f))

;; converge this with the ini-file egg and the Megatest config reader. 
;;
(define (read-dat fname #!key (record 'col)) ;; record 'col or 'row
  (if (create-empty-dat fname)
      (let ((section-rx  (regexp "^\\[(.*)\\]\\s*$"))
	    (comment-rx  (regexp "^#.*"))          ;; This means a cell name cannot start with #
	    (quoted-cell-rx (regexp "^\"([^\"]*)\" (.*)$"))
	    (cell-rx     (regexp "^(\\S+) (.*)$")) ;; One space only for the cellname content separator 
	    (blank-rx    (regexp "^\\s*$"))
	    (continue-rx (regexp ".*\\\\$"))
	    (var-no-val-rx (regexp "^(\\S+)\\s*$"))
	    (inp         (open-input-file fname))
	    (cmnt-indx   (make-hash-table))
	    (blnk-indx   (make-hash-table))
	    (first-section "")) ;; used for zeroth title
	(let loop ((inl     (read-line inp))
		   (section ".............")
		   (res     '()))
	  (if (eof-object? inl)
	      (begin
		(close-input-port inp)
		(let ((newres (cons (list first-section first-section first-section)
				    (reverse res))))
		  (if (eq? record 'col)
		      newres
		      (transpose-dat newres))))
	      (regex-case
	       inl 
	       (continue-rx _         (loop (conc inl (read-line inp)) section res))
	       (comment-rx _          (let ((curr-indx (+ 1 (hash-table-ref/default cmnt-indx section 0))))
					(hash-table-set! cmnt-indx section curr-indx)
					(loop (read-line inp)
					      section 
					      (cons (list (conc "#CMNT" curr-indx) section inl) res))))
	       (blank-rx   _          (let ((curr-indx (+ 1 (hash-table-ref/default blnk-indx section 0))))
					(hash-table-set! blnk-indx section curr-indx)
					(loop (read-line inp)
					      section
					      (cons (list (conc "#BLNK" curr-indx) section " ") res))))
	       (section-rx (x sname)  (begin
					(if (not first-section)
					    (set! first-section sname))
					(loop (read-line inp) 
					      sname 
					      res)))
	       (quoted-cell-rx (x k v)(loop (read-line inp)
					    section
					    (cons (list k section v) res)))
	       (cell-rx   (x k v)     (loop (read-line inp)
					    section
					    (cons (list k section v) res)))
	       (var-no-val-rx (x k)   (loop (read-line inp)
					    section
					    (cons (list k section "") res)))
	       (else                  (begin
					(print "ERROR: Unrecognised line in input file " fname ", ignoring it")
					(loop (read-line inp) section res)))))))
      '(("" "" ""))))

(define (dat-lookup dat section var)
  (let ((res (assoc section (map cdr (filter (lambda (x)(equal? (car x) var)) dat)))))
    (if res
	(cadr res)
	#f)))

Changes to testrefdb/Sheet1.dat.

1
2
3
4
5
6
7
8
9
10
11
12
13
[b]
2 b2
3 b3
4 b4
5 b5
6 b6
[c]
2 c2
[d]
2 d2
[e]
2 e2
6 e6
<
<
<
<
<
<
<
<
<
<
<
<
<


























Changes to testrefdb/sheet-names.cfg.

1
2

Sheet1
Sheet2



>
1
2
3
Sheet1
Sheet2
Sheet3