;;;
;;; info.scm - parse info file
;;;  
;;;   Copyright (c) 2000-2003 Shiro Kawai, All rights reserved.
;;;   
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;   
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;  
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;  
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;  
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;  
;;;  $Id: info.scm,v 1.3 2003/07/05 03:29:12 shirok Exp $
;;;

(define-module text.info
  (use srfi-13)
  (use srfi-14)
  (use text.parse)
  (use gauche.process)
  (use file.util)
  (export <info-file> <info-node>
          open-info-file info-get-node info-parse-menu
          )
  )
(select-module text.info)

;; NB: node-table maps node name (string) => <info-node> or
;; subinfo-file (string).
(define-class <info-file> ()
  ((path           :init-keyword :path)
   (directory      :init-keyword :directory)
   (node-table     :init-form (make-hash-table 'string=?))
   ))

(define-class <info-node> ()
  ((name    :init-keyword :name)
   (next    :init-keyword :next)
   (prev    :init-keyword :prev)
   (up      :init-keyowrd :up)
   (file    :init-keyword :file)
   (content :init-keyword :content)
   ))

;; Find gunzip location
(define gunzip (find-file-in-paths "gunzip"))

;; Read an info file FILE, and returns a list of strings splitted by ^_ (#\x1f)
;; If FILE is not found, look for gzipped one (FILE.gz) and decompress it.
(define (read-info-file-split file opts)
  (define (with-input-from-info thunk)
    (cond ((file-exists? file)
           (with-input-from-file file thunk))
          ((file-exists? #`",|file|.gz")
           (with-input-from-process #`",gunzip -c ,file" thunk))
          (else
           (error "can't find info file" file))))
  (with-input-from-info
   (lambda ()
     (let loop ((c (skip-while (char-set-complement #[\x1f])))
                (r '()))
       (if (eof-object? c)
           (reverse! r)
           (let* ((head (next-token #[\x1f\n] '(#[\x1f\n] *eof*)))
                  (body (next-token #[\n] '(#[\x1f] *eof*))))
             (loop (read-char) (acons head body r)))))))
  )

(define (read-master-info-file file opts)
  (let1 parts (read-info-file-split file opts)
    (when (null? parts)
      (error "file is not an info file" file))
    (let1 info (make <info-file> :path file :directory (sys-dirname file))
      (if (string=? (caar parts) "Indirect:")
          (let1 indirect-table (parse-indirect-table (cdar parts))
            (parse-tag-table info indirect-table (cdr (cadr parts))))
          (parse-nodes info parts))
      info)))

(define (parse-indirect-table indirects)
  (with-input-from-string indirects
    (lambda ()
      (port-map (lambda (line)
                  (rxmatch-case line
                    (#/^([^:]+):\s+(\d+)/ (#f file count)
                        (cons (x->integer count) file))
                    (else '())))
                read-line))))

(define (parse-tag-table info indirect tags)
  (define (find-file count)
    (let loop ((indirect indirect)
               (prev #f))
      (cond ((null? indirect) prev)
            ((< count (caar indirect)) prev)
            (else (loop (cdr indirect) (cdar indirect))))))
  (with-input-from-string tags
    (lambda ()
      (port-for-each (lambda (line)
                       (rxmatch-case line
                         (#/^Node: ([^\x7f]+)\x7f(\d+)/ (#f node count)
                           (hash-table-put! (ref info 'node-table)
                                            node
                                            (find-file (x->integer count))))
                         (else line #f)))
                     read-line)))
  )

(define (read-sub-info-file info file opts)
  (let1 parts (read-info-file-split file opts)
    (when (null? parts)
      (error "file is not an info file" file))
    (parse-nodes info parts)))

(define (parse-nodes info parts)
  (for-each (lambda (p)
              (unless (string=? (car p) "Tag Table:")
                (parse-node info p)))
            parts))

(define (parse-node info part)
  (rxmatch-case (car part)
    (#/File: [^,]+,  Node: ([^,]+)(,  Next: ([^,]+))?,  Prev: ([^,]+),  Up: ([^,]+)/
     (#f node #f next prev up)
     (let1 info-node (make <info-node>
                       :node node :next next :prev prev :up up :file info
                       :content (cdr part))
       (hash-table-put! (ref info 'node-table) node info-node)
       info-node))
    (else #f)
    ))

;;; External API

(define (open-info-file file)
  (read-master-info-file file '()))

(define-method info-get-node ((info <info-file>) nodename)
  (let1 node (hash-table-get (ref info 'node-table) nodename #f)
    (and node
         (if (is-a? node <info-node>)
             node
             (begin
               (read-sub-info-file info
                                   (build-path (ref info 'directory) node)
                                   '())
               (hash-table-get (ref info 'node-table) nodename #f))))))

(define-method info-parse-menu ((info <info-node>))
  (with-input-from-string (ref info 'content)
    (lambda ()
      (define (skip line)
        (cond ((eof-object? line) '())
              ((string=? line "* Menu:") (menu (read-line) '()))
              (else (skip (read-line)))))
      (define (menu line r)
        (rxmatch-case line
          (test eof-object? (reverse! r))
          (#/^\* (.+)::/ (#f node)
           (menu (read-line) (acons node node r)))
          (#/^\* (.+):\s+(.+)\./ (#f index node)
           (menu (read-line) (acons index node r)))
          (else (menu (read-line) r))))
      (skip (read-line)))))

(provide "text/info")
