diff options
Diffstat (limited to 'db2html.scm')
| -rw-r--r-- | db2html.scm | 76 |
1 files changed, 50 insertions, 26 deletions
diff --git a/db2html.scm b/db2html.scm index df34389..8ad97e1 100644 --- a/db2html.scm +++ b/db2html.scm @@ -52,10 +52,10 @@ ;;@body Outputs a heading row for the currently-started table. (define (html:heading columns) - (sprintf #f " <TR VALIGN=\"TOP\">\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=\"TOP\">\\n%s\\n" (apply string-append (map (lambda (datum) - (sprintf #f " <TH>%s</TH>\\n" (or datum ""))) + (sprintf #f " <TH>%s\\n" (or datum ""))) columns)))) ;;@body Outputs a heading row with column-names @1 linked to URIs @2. @@ -92,11 +92,11 @@ (cond ((eqv? (string-index str #\newline) len) (string-append "<TT>" (substring str 0 len) "</TT>")) (else (html:pre str)))))) - (sprintf #f " <TR VALIGN=TOP>\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=TOP>\\n%s\\n" (apply string-append (map (lambda (idx datum foreign) (sprintf - #f " <TD>%s%s</TD>\\n" + #f " <TD>%s%s\\n" (if (eqv? 1 idx) (row->anchor pkl row) "") (cond ((or (not datum) (null? datum)) "") ((not foreign) (present datum)) @@ -121,8 +121,9 @@ table-name)) ;;@args caption db table-name match-key1 @dots{} -;;Returns HTML string for @2 table @3. Every foreign-key value is -;;linked to the page (of the table) defining that key. +;;Returns HTML string for @2 table @3 chopped into 50-row HTML tables. +;;Every foreign-key value is linked to the page (of the table) +;;defining that key. ;; ;;The optional @4 @dots{} arguments restrict actions to a subset of ;;the table. @xref{Table Operations, match-key}. @@ -132,19 +133,42 @@ (tags (map table-name->filename foreigns)) (names (table 'column-names)) (primlim (table 'primary-limit))) - (apply html:table "CELLSPACING=0 BORDER=1" - (html:caption caption 'BOTTOM) - (html:href-heading - names - (append (make-list primlim - (table-name->filename - (table-name->column-table-name db table-name))) - (make-list (- (length names) primlim) #f))) - (html:heading (table 'column-domains)) - (html:href-heading foreigns tags) - (html:heading (table 'column-types)) - (map (html:linked-row-converter primlim tags) - (apply (table 'row:retrieve*) args))))) + (define tables '()) + (define rows '()) + (define cnt 0) + (define (make-table rows) + (apply html:table "CELLSPACING=0 BORDER=1" + (html:caption caption 'BOTTOM) + (html:href-heading + names + (append (make-list primlim + (table-name->filename + (table-name->column-table-name db table-name))) + (make-list (- (length names) primlim) #f))) + (html:heading (table 'column-domains)) + (html:href-heading foreigns tags) + (html:heading (table 'column-types)) + rows)) + (apply (table 'for-each-row) + (lambda (row) + (set! cnt (+ 1 cnt)) + (set! rows (cons row rows)) + (cond ((<= 50 cnt) + (set! tables + (cons (make-table + (map (html:linked-row-converter primlim tags) + (reverse rows))) + tables)) + (set! cnt 0) + (set! rows '())))) + args) + (apply string-append + (reverse (if (and (null? rows) (not (null? tables))) + tables + (cons (make-table + (map (html:linked-row-converter primlim tags) + (reverse rows))) + tables)))))) ;;@body ;;Returns a complete HTML page. The string @3 names the page which @@ -162,10 +186,10 @@ (html:body (apply table->linked-html table-name db table-name args)))) (define (html:catalog-row-converter row foreigns) - (sprintf #f " <TR VALIGN=TOP>\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=TOP>\\n%s\\n" (apply string-append (map (lambda (datum foreign) - (sprintf #f " <TD>%s%s</TD>\\n" + (sprintf #f " <TD>%s%s\\n" (html:anchor (sprintf #f "%s" datum)) (html:link (make-uri foreign #f #f) datum))) row foreigns)))) @@ -384,7 +408,7 @@ (else (list fld)))) row arities) foreign-choice-lists)) - (sprintf #f " <TR>\\n <TD>%s</TD>%s\\n </TR>\\n" + (sprintf #f " <TR>\\n <TD>%s%s\\n\\n" (string-append (html:hidden '*row-hash* (crc:hash-obj row)) (html:hidden '*keys* (uri:make-path (butnthcdr pkl row))) @@ -394,7 +418,7 @@ ;; (form:image "Modify Row" "/icons/bang.png") ) (apply string-append - (map (lambda (elt) (sprintf #f " <TD>%s</TD>\\n" elt)) + (map (lambda (elt) (sprintf #f " <TD>%s\\n" elt)) (cdr elements)))))))) ;;@args k names edit-point edit-converter @@ -427,11 +451,11 @@ (else (html:pre str)))))))) (lambda (row) (string-append - (sprintf #f " <TR VALIGN=TOP>\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=TOP>\\n%s\\n" (apply string-append (map (lambda (idx datum foreign) (sprintf - #f " <TD>%s%s</TD>\\n" + #f " <TD>%s%s\\n" (if (eqv? 1 idx) (row->anchor pkl row) "") (cond ((or (not datum) (null? datum)) "") ((<= idx pkl) @@ -487,7 +511,7 @@ (if (symbol? dir) (set! dir (symbol->string dir))) (if (not (file-exists? dir)) (make-directory dir)) (db->html-files db dir index-filename dir) - (path->uri (in-vicinity (sub-vicinity "" dir) index-filename))) + (path->uri (in-vicinity (sub-vicinity (user-vicinity) dir) index-filename))) ;;@args db dir index-filename ;;@args db dir |