;;
;; scbib - a bibliography management system 
;;
;; Copyright (C) 2004 Satoru Takabayashi <satoru@namazu.org> 
;;
;; You can redistribute it and/or modify it under the terms of 
;; the Gauche's licence.
;;
;; Ported to Chicken Scheme and modified 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-bibtex

  (scbib-bibtex-print-item)

  (import scheme chicken)
  (require-library ports)
  (require-extension regex extras srfi-1 srfi-13 scbib)
  (import (only ports with-output-to-string))


;; based on SRV:send-reply by Oleg Kiselyov
(define (print-fragments b)
  (let loop ((fragments b) (result #f))
    (cond
      ((null? fragments) result)
      ((pair? fragments)
       (cond
	((not (car fragments)) (loop (cdr fragments) result))
	((null? (car fragments)) (loop (cdr fragments) result))
	((eq? #t (car fragments)) (loop (cdr fragments) #t))
	((pair? (car fragments))
	 (loop (cdr fragments) (loop (car fragments) result)))
	((procedure? (car fragments))
	 ((car fragments))
	 (loop (cdr fragments) #t))
	(else
	 (display (car fragments))
	 (loop (cdr fragments) #t))))
      (else (display fragments)))))

(define (scbib-bibtex-print-item bibitem . rest)
 (let-optionals rest ((key-style #f) (output-port #t))
  (define (scbib-bibtex-print-sub bibitem)
    (define (authors)
      (let ((authors (scbib-get-authors bibitem)))
	(cond ((eq? authors #f)
	       "")
	      ((= (length authors) 1)
	       (car authors))
	      (else
	       (string-join authors " and ")))))

    (define (editors)
      (let ((editors (scbib-values bibitem 'editor)))
	(cond ((eq? editors #f)
	       #f)
	      ((= (length editors) 1)
	       (car editors))
	      (else
	       (string-join editors " and ")))))

    (define r1 (regexp "#"))
    (define r2 (regexp "~"))
    (define r3 (regexp "\\/\\\\~\\{\\}"))
    (define r4 (regexp "\\/"))

    (define (escape string)
      (cond ((string? string)
	     (let* ((string (string-substitute  r1  "\\#" string #t))
		    (string (string-substitute  r2  "\\~{}" string #t))
		    (string (string-substitute  r3  "\\slash\\~{}" string #t))
		    (string (string-substitute  r4  "{\\slash}" string #t)))
	       string))
	    ((pair? string) (map escape string))
	    (else string)))

    (define (get field)
      (let* ((item (scbib-value bibitem field))
	     (str  (and item (with-output-to-string
			       (lambda () (print-fragments (escape item)))))))
	str))

    (define (itemize field-name item)
      (if item
	  (format #f "    ~a = {~a},~%" field-name item)
	  ""))

    (define (note)
      (let ((x (get 'note)))
	(or x (if (equal? (get 'bibtype) "web")
		  (get 'web)
		  #f))))

    (format output-port "@~a{~a,\n~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a~a}~%"
	    (let ((bibtype (get 'bibtype)))
	      (cond ((not bibtype) (error 'scbib-bibtex-print-item "bibtype not given for item" bibitem))
		    ((and (string? bibtype) (string=? bibtype "web"))  "misc")
		    (else bibtype)))
	    (scbib-get-abbrev bibitem key-style)
	    (itemize "author" (authors))
	    (itemize "editor" (editors))
	    (itemize "title" (get 'title))
	    (itemize "series" (get 'series))
	    (itemize "edition" (get 'edition))
	    (itemize "publisher" (get 'publisher))
	    (itemize "year" (get 'year))

	    (itemize "pages" (get 'pages))
	    (itemize "booktitle" (get 'booktitle))
	    (itemize "organization" (get 'organization))
	    (itemize "address" (get 'address))
	    (itemize "note" (note))
;	    (itemize "month" (get 'month))
	    (itemize "volume"  (get 'volume))
	    (itemize "number"  (get 'number))
	    (itemize "school"  (get 'school))
	    (itemize "journal" (get 'journal))
	    (itemize "eid" (get 'eid))
	    (itemize "doi" (get 'doi))
	    )
    )

  (scbib-bibtex-print-sub bibitem)))

)