[skribilo-users] Floating tables

[Roger Mason]

Hello,

I'm attempting to implement the option to have tables numbered and, in
LaTeX output, as floating objects with a caption.

This is the code for "table", with a couple of ancillary functions, in
latex.scm (based on 0.9.3):

;*---------------------------------------------------------------------*/
;*    &latex-floating-table-start                                      */
;*---------------------------------------------------------------------*/
(markup-writer '&latex-floating-table-start
               :options '()
               :action (lambda (n e)
                         (display "\\begin{table}[htbp]\n"
                         )))

;*---------------------------------------------------------------------*/
;*    &latex-floating-table-stop                                       */
;*---------------------------------------------------------------------*/
(markup-writer '&latex-floating-table-stop
               :options '(:legend :ident)
               :action (lambda (n e)
                         (let ((legend (markup-option n :legend))
                               (ident (markup-ident n)))
                           (format #t "\\caption{\\label{~a}" 
(string-canonicalize ident)) ;(expecting string): #f
                           ;;(display "\\caption{")
                           (output legend e) ;this is always empty: why?
                           ;;(display legend)
                           (display "}\n\\end{table}\n"))))

;*---------------------------------------------------------------------*/
;*    table ...                                                        */
;*---------------------------------------------------------------------*/
(markup-writer 'table
   :options '(:floating :number :legend :width :frame :rules :cellstyle :ident)
   :before (lambda (n e)
             (let ((floating (markup-option n :floating))
                   (number (markup-option n :number))
                   (legend (markup-option n :legend))
                   (width (markup-option n :width))
                    (frame (markup-option n :frame))
                    (rules (markup-option n :rules))
                    (cstyle (markup-option n :cellstyle))
                    (nbcols (table-column-number n))
                    (id (markup-ident n))
                    (rows (markup-body n)))
               (when (eq? floating #t)
                   (output (new markup
                                (markup '&latex-floating-table-start)
                                (class "table")
                                (options `(())))
                           e)
                   )
                 ;; the table header
                 (output (new markup
                            (markup '&latex-table-start)
                            (class "table")
                            (options `((width ,width))))
                         e)
                 ;; store the actual number of columns
                 (markup-option-add! n '&nbcols nbcols)
                 ;; compute the table header
                 (let ((cols (cond
                                ((= nbcols 0)
                                 (skribe-error 'table
                                               "Invalid empty table"
                                               n))
                                ((or (not width) (= nbcols 1))
                                 (make-string nbcols #\c))
                                (else
                                 (let ((v (make-vector 
                                           (- nbcols 1)
                                           "@{\\extracolsep{\\fill}}c")))
                                    (string-concatenate
                                           (cons "c" (vector->list v))))))))
                    (case frame
                       ((none)
                        (format #t "{~a}\n" cols))
                       ((border box)
                        (format #t "{|~a|}" cols)
                        (markup-option-add! n '&lhs #t)
                        (markup-option-add! n '&rhs #t)
                        (output (new markup
                                   (markup '&latex-table-hline)
                                   (parent n)
                                   (ident (format #f "~a-above" id))
                                   (class "table-line-above"))
                                e))
                       ((above hsides)
                        (format #t "{~a}" cols)
                        (output (new markup
                                   (markup '&latex-table-hline)
                                   (parent n)
                                   (ident (format #f "~a-above" id))
                                   (class "table-line-above"))
                                e))
                       ((vsides)
                        (markup-option-add! n '&lhs #t)
                        (markup-option-add! n '&rhs #t)
                        (format #t "{|~a|}\n" cols))
                       ((lhs)
                        (markup-option-add! n '&lhs #t)
                        (format #t "{|~a}\n" cols))
                       ((rhs)
                        (markup-option-add! n '&rhs #t)
                        (format #t "{~a|}\n" cols))
                       (else
                        (format #t "{~a}\n" cols)))
                    ;; mark each row with appropriate '&tl (top-line)
                    ;; and &bl (bottom-line) options
                    (when (pair? rows)
                       (if (and (memq rules '(rows all))
                                (or (not (eq? cstyle 'collapse))
                                    (not (memq frame '(border box above 
hsides)))))
                           (let ((frow (car rows)))
                              (if (is-markup? frow 'tr)
                                  (markup-option-add! frow '&tl #t))))
                       (if (eq? rules 'header)
                           (let ((frow (car rows)))
                              (if (is-markup? frow 'tr)
                                  (markup-option-add! frow '&bl #t))))
                       (when (and (pair? (cdr rows))
                                  (memq rules '(rows all)))
                          (for-each (lambda (row)
                                       (if (is-markup? row 'tr)
                                           (markup-option-add! row '&bl #t)))
                                    rows)
                          (markup-option-add! (car (last-pair rows)) '&bl #f))
                       (if (and (memq rules '(rows all))
                                (or (not (eq? cstyle 'collapse))
                                    (not (memq frame '(border box above 
hsides)))))
                           (let ((lrow (car (last-pair rows))))
                              (if (is-markup? lrow 'tr)
                                  (markup-option-add! lrow '&bl #t))))))))
   :after (lambda (n e)
            (let ((floating (markup-option n :floating))
                   (number (markup-option n :number))
                   (legend (markup-option n :legend)))
             (case (markup-option n :frame)
                ((hsides below box border)
                 (output (new markup
                            (markup '&latex-table-hline)
                            (parent n)
                            (ident (format #f "~a-below" (markup-ident n)))
                            (class "table-hline-below"))
                         e)))
             (output (new markup
                        (markup '&latex-table-stop)
                        (class "table")
                        (options `((width ,(markup-option n :width)))))
                     e)
             (when (eq? floating #t)
                 (output (new markup
                              (markup '&latex-floating-table-stop)
                              (class "table")
                              (options `((legend ,(markup-option n :legend))
                                         (ident ,(markup-ident n)))))
                         e)
                   )
)))

This test document:

(document :title []

(p [It's not clear how to get vertical and horizontal lines on all cells.

]);; End section

(center
   (table :border 1 :width 50. :frame 'hsides :cellstyle 'collapse :number #t
      (tr :bg "#cccccc" (th :align 'center :colspan 3 "A table"))
      (tr (th "Col 1") (th "Col 2") (th "Col 3"))
      (tr (td :align 'center "10") (td "-20") (td "30"))
      (tr (td :align 'right :rowspan 2 :valign 'center "12") (td "21"))
      (tr (td :align 'center :colspan 2 "1234"))
      (tr (td :align 'center :colspan 2 "1234") (td :align 'right "5"))
      (tr (td :align 'center :colspan 1 "1") (td :colspan 2 "2345"))))

(p [I put this in to test the spacing of tables.])

 (table :border 1 :width 50 :frame 'hsides :cellstyle 'collapse :floating #t 
:number #t :legend "Synonyms for Poo" :ident "0"
        (tr :bg "#dddddd" (th :align 'center :colspan 3 "Muck"))
        (tr (th "This") (th "That") (th "The Other"))
        (tr (td "Crap") (td "Poo") (td "Dung")))


);; End document

fails with this message:

Backtrace:
In ice-9/boot-9.scm:
 157: 18 [catch #t #<catch-closure 287dd760> ...]
In unknown file:
   ?: 17 [apply-smob/1 #<catch-closure 287dd760>]
In ice-9/boot-9.scm:
  63: 16 [call-with-prompt prompt0 ...]
In ice-9/eval.scm:
 432: 15 [eval # #]
In unknown file:
   ?: 14 [call-with-input-string "\n\n;; Tell Guile not to issue warnings about 
duplicate bindings.\n(default-duplicate-binding-handler 
'(last))\n\n(use-modules (skribilo 
condition))\n\n(call-with-skribilo-error-catch/exit\n  (lambda ()\n    (apply 
(module-ref (resolve-interface '(skribilo)) 'skribilo) (cdr (command-line)))))" 
...]
In ice-9/command-line.scm:
 180: 13 [#<procedure 287df560 at ice-9/command-line.scm:175:6 (port)> #<input: 
string 2865eb60>]
In unknown file:
   ?: 12 [eval (call-with-skribilo-error-catch/exit #) #<directory # 28757630>]
In ice-9/boot-9.scm:
 171: 11 [with-throw-handler srfi-34 ...]
In ../../../skribilo-0.9.3/src/guile/skribilo.scm:
 425: 10 [skribilo "-t" "latex" ...]
In ice-9/boot-9.scm:
 867: 9 [call-with-input-file "Tables_13029_more.skb" ...]
In ice-9/r4rs.scm:
 172: 8 [with-input-from-port #<variable 295e2390 value: #<input: file 
/dev/pts/2>> ...]
In ../../../skribilo-0.9.3/src/guile/skribilo.scm:
 150: 7 [doskribe #<module (#{ g1793}#) 29579048>]
In ../../../skribilo-0.9.3/src/guile/skribilo/output.scm:
 132: 6 [#<procedure 29897320 at 
../../../skribilo-0.9.3/src/guile/skribilo/output.scm:132:0 (node e)> # ...]
 105: 5 [%out/writer # # #]
 141: 4 [#<procedure 29559010 at 
../../../skribilo-0.9.3/src/guile/skribilo/output.scm:137:0 (node e)> # ...]
 105: 3 [%out/writer # # #]
In ../../../skribilo-0.9.3/src/guile/skribilo/engine/latex.scm:
1165: 2 [#<procedure 2959df50 at 
../../../skribilo-0.9.3/src/guile/skribilo/engine/latex.scm:1162:23 (n e)> # 
...]
In ../../../skribilo-0.9.3/src/guile/skribilo/utils/strings.scm:
  52: 1 [string-canonicalize #f]
In unknown file:
   ?: 0 [string-length #f]

ERROR: In procedure string-length:
ERROR: In procedure string-length: Wrong type argument in position 1
(expecting string): #f

Any help in debugging this would be most welcome.

Thanks,
Roger