;;
;; scbib-style
;;
;; Copyright 2009 by Ivan Raikov.
;;
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.

(module scbib-style

  (bibstyle?
   BibNil BibLit BibField BibKey 
   BibEmph BibHilite BibCons BibCond
   scbib-style-print-item)

  (import scheme chicken)

  (require-extension regex extras srfi-1 srfi-13 data-structures datatype scbib)

  
  (define-datatype bibstyle bibstyle?
    (BibNil)
    (BibLit     (text string?))
    (BibField   (name symbol?))
    (BibKey     (key-style procedure?))
    (BibEmph    (contents bibstyle?))
    (BibHilite  (contents bibstyle?))
    (BibCons    (car bibstyle?) (cdr bibstyle?))
    (BibCond    (test procedure?) (consequent bibstyle?) 
		(alternate bibstyle?)))


  (define (scbib-style-print-item style bibitem #!key (out #f) 
				  (escape identity) (emph identity) (hilite identity))

    (define (get field . rest)
      (let ((item (scbib-value bibitem field)))
	(and item (escape item))))

    (define (recur cont out)
      (scbib-style-print-item style cont out: out
			      escape: escape emph: emph 
			      hilite: hilite))

    (define (sub f x)
      (let ((out1 (open-output-string)))
	(recur x out1)
	(let ((str (get-output-string out1)))
	  (close-output-port out1)
	  (fprintf out "~A" (f str)))))


      (cases bibstyle style
	     (BibNil ()         (begin))
	     (BibLit (text)     (fprintf out "~A" (escape text)))
	     (BibField (name)   (fprintf out "~A" (get name)))
	     (BibKey (kstyle)   (fprintf out "~A" (scbib-get-abbrev bibitem kstyle)))
	     (BibEmph (cont)    (sub emph cont))
	     (BibHilite (cont)  (sub hilite cont))
	     (BibCons (kar kdr) (begin (recur kar out)
				       (recur kdr out)))

	     (BibCond (test consequent alternate)
		      (if (test bibitem) (recur consequent out)
			  (recur alternate out)))
				       
	     ))
)