;;
;; scbib - a bibliography management system
;;
;; Copyright (C) 2004 Satoru Takabayashi <satoru@namazu.org> 
;;
;; 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

  (scbib-db-person
   scbib-db-publisher
   scbib-db-journal
   scbib-db-bib
   scbib-find
   scbib-values
   scbib-value
   scbib-load-db
   scbib-load-db-from-port
   scbib-load-db-all
   scbib-load-path
   scbib-match
   scbib-get-authors
   scbib-get-abbrev
   scbib-print-abbrev-list
   scbib-add-to-db!
   )

  (import scheme chicken)
  (require-extension srfi-1 regex extras files posix data-structures datatype)
  


;; DBs
(define scbib-db-person    (make-parameter '()))
(define scbib-db-publisher (make-parameter '()))
(define scbib-db-journal   (make-parameter '()))
(define scbib-db-bib       (make-parameter '()))

(define scbib-load-path (make-parameter "."))

(define (scbib-find query db)
  (cond ((null? db)
	 #f)
	((query (car db))
	 (car db))
	(else 
	 (scbib-find query (cdr db)))))

(define (scbib-values item name)
  (let ((name (if (symbol? name) name (string->symbol name))))
    (cond ((null? item)
	   #f)
	  ((equal? (caar item) name)
	   (cdar item))
	  (else
	   (scbib-values (cdr item) name)))))

(define (scbib-value item name)
  (let ((val (scbib-values item name)))
    (if val
	(car val)
	#f)))

(define (scbib-add-to-db! item)
  (let* ((db-type (car item))
	 (contents (cdr item)))
    (case db-type
      ((person) 
       (scbib-db-person
	(cons contents (scbib-db-person))))
      ((publisher)
       (scbib-db-publisher
	(cons contents (scbib-db-publisher))))
      ((journal)
       (scbib-db-journal
	(cons contents (scbib-db-journal))))
      ((bib)
       (scbib-db-bib
          (cons contents (scbib-db-bib)))))))

(define (scbib-load-db-from-port iport)
  (let loop ()
    (let ((item (read iport)))
      (unless (eof-object? item)
              (scbib-add-to-db! item)
              (loop)))))

(define (scbib-load-db file)
  (let ((file (if (file-exists? file)
		  file
		  (make-pathname (scbib-load-path) file))))
        (call-with-input-file file
          (lambda (iport)
            (scbib-load-db-from-port iport)))))

(define (scbib-load-db-all)
  (for-each (lambda (file) (scbib-load-db file))
	    (find-files (scbib-load-path) ".+.db$")))


(define r1 (regexp "^([^a-z ]+) [^a-z ]+$"))
(define r2 (regexp "^([^ ]+), [^ ]+$"))
(define r3 (regexp "([^ ]+)( Jr\\.)$"))
(define r4 (regexp "([^ ]+)$"))

(define scbib-get-abbrev
  (let ((abbrev-alist '()))
    (lambda (bibitem . rest)
      (let-optionals rest ((key-style #f))

      (define (family-name name)
        (cond ((string-search r1 name) => (lambda (m) (list-ref m 1)))
	      ((string-search r2 name) => (lambda (m) (list-ref m 1)))
              ((string-search r3 name) => (lambda (m) (list-ref m 1)))
              ((string-search r4 name) => (lambda (m) (list-ref m 1)))))

      (define (generate-abbrev)
        (let* ((authors (scbib-get-authors bibitem))
               (author (if authors (car authors) #f))
               (editor (scbib-value bibitem 'editor)))
          (let ((author (family-name (or author
                                         editor
                                         "Anonymous")))
                (year (or (scbib-value bibitem 'year) "XXXX")))
	    (or (and key-style (key-style author year))
		(format #f "~a:~a" author year)))))

      (let* ((abbrev-candidate
              (or (scbib-value bibitem 'abbrev) (generate-abbrev)))
             (abbrev-item (assoc abbrev-candidate abbrev-alist)))
        (if abbrev-item 
            (let ((count (cdr abbrev-item)))
              (set-cdr! abbrev-item (+ count 1))
              (string-append abbrev-candidate "-" 
                             (number->string (+ count 1))))
            (begin 
              (set! abbrev-alist 
                    (cons (cons abbrev-candidate 1) abbrev-alist))
              abbrev-candidate))))))
  )

(define (scbib-get-authors bibitem)
  (let ((title (scbib-value bibitem 'title))
        (original-title (scbib-value bibitem 'original-title)))
    (if original-title 
        ;; if the original title exists
        (let ((original-bibitem
               (scbib-find (lambda (x) 
                             (equal? (car (scbib-values x 'title)) 
                                     original-title)) 
                           (scbib-db-bib))))
          (append (scbib-values original-bibitem 'author)
                  (let ((r (reverse (scbib-values bibitem 'author))))
		    (reverse (cons (string-append (car r) " Ìõ")
				   (cdr r))))))
        (scbib-values bibitem 'author))))

(define (scbib-print-abbrev-list)
  (for-each (lambda (bib) 
	      (format #t "~a\n" (scbib-value bib 'abbrev)))
	    (reverse (scbib-db-bib))))



;; (scbib-match item bibtype: "book")
;; (scbib-match item bibtype: "book" category: '(not "programming"))
;; (scbib-match item bibtype: '(or "book" "article"))
(define (scbib-match  #!key bibtype category subcategory)
  (lambda (item)
    (every (lambda (key value)
	     (or (eq? value #f)
		 (let ((v (scbib-value item key)))
		   (cond ((and (pair? value) (eq? (first value) 'not))
			  (not (equal? v (second value))))
		       ((and (pair? value) (eq? (first value) 'or))
			(any (lambda (vv) (equal? v vv))
			     (cdr value)))
		       (else
			(equal? v value))))
		 ))
	   '(bibtype category subcategory)
	   (list bibtype category subcategory))))

(define-datatype bibstyle bibstyle?
  (BibNil)
  (BibCons    (car bibstyle?) (cdr bibstyle?))
  (BibText    (text string?))
  (BibField   (extract procedure?))
  (BibCond    (test procedure?) (consequent bibstyle?) (alternate bibstyle?)))

)