#!/usr/bin/env gsi-script 

;; This file is part of iwtf
;; Copyright (C) 2008 Joel J. Adamson

;; iwtf 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, 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.

;; You should have received a copy of the GNU General Public License
;; along with this program (see the file COPYING); if not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;; $Id$


;; Some utility functions for dealing wth files and text

;; these two borrowed from Dorai sitaram: teach yourself scheme in
;; fixnum days, section 17.2
(define (split c s)
  (let loop ((s s))
    (if (string=? s "") '()
        (let ((i (string-index s c)))
          (if i (cons (substring s 0 i)
                      (loop (substring s (+ i 1)
                                       (string-length s))))
              (list s))))))
(define (string-index s c)
  (let ((n (string-length s)))
    (let loop ((i 0))
      (cond ((>= i n) #f)
            ((char=? (string-ref s i) c) i)
            (else (loop (+ i 1)))))))

(define (file-readable? file)
  (and 
   (file-exists? file)
   (> (file-info-mode (file-info file)) #o400)))   

(define (create-new-database? user)
  (if (file-exists? (string-append
                     (user-info-home (user-info user))
                     "/."
                     (path-strip-directory *acro-file*)))
      #f #t))

(define (create-local-database user)
  (if *site-acro-file*
      (begin
        (copy-file *acro-file*
                   (string-append
                    (user-info-home (user-info user))
                    "/."
                    (path-strip-directory *acro-file*)))
        *local-acro-file*)
      #f))



;; A Global variable:

(define *user* (getenv "USER"))
(define *local-acro-file* (let ((file (string-append
                                       (user-info-home (user-info
                                                        *user*))
                                       "/.acronyms")))
                            (if (file-exists? file) file #f)))

(define *site-acro-file* (let ((file "/usr/share/misc/acronyms"))
                           (if (file-exists? file) file #f)))


(define *acro-file* (or *local-acro-file* *site-acro-file*))
(define *oops-message-cont* #f)

(define *teach-me-prompt*  "
Please select from the following menu:
  
(0) Teach me, iwtf, a new acronym

(1) Teach me a synonym

(2) Look up a new acronym

(3) Exit iwtf altogether

Selection:
")

(define *input-prompt* "iwtf is ")
(define *top-level-cont* #f)
;; the main algorithm
;; searches through a file and finds the acronym, returning the result
(define (find-acronym acronym)
  (letrec ((acronyms-port (open-input-file *acro-file*))
           (force-acronyms-port (lambda ()
                                  (let ((line (read-line
                                               acronyms-port)))
                                    (if (not (eof-object? line))
                                        (split #\tab line)
                                        #f))))
           (loop-over-file (lambda (input)
                             (let ((input-line input))
                               (cond ((not input-line) #f)
                                     ((and (pair? input-line)
                                           (string-ci=? (object->string acronym) (car input-line)))
                                      (cadr input-line))
                                     (else (loop-over-file (force-acronyms-port))))))))
    (loop-over-file (force-acronyms-port))))

(define (oops-message acronym)
  (display (string-append
            "Wow, I really ought to know what \""
            (object->string acronym)
            "\" means."))
  (newline)
  (learn-new-acronym acronym (teach-me?)))

(define (teach-me?)
  (teach-me-message)
  (prompt-for-input *teach-me-prompt*)
  (read))

(define (teach-me-message)
  (display "
I can learn a new acronym and place it in your private database, or
learn new synonyms for acronyms that I already know.  I put synonyms
in a local hidden file (starting with \".\").
"))

(define (learn-new-acronym new selection)
  (case selection
    ((3) (exit))
    ((2) (iwtf-loop))
    ((1) (learn-synonym new))
    ((0) (learn-acronym new))
    (else (oops-message selection))))

(define (learn-synonym syn)
  (display "This procedure does nothing."))

(define (learn-acronym acro)
  (call-with-output-file (list path: (if (not *local-acro-file*)
                                         (create-local-database *user*)
                                         ;; return to top level
                                         *local-acro-file*)
                               append: #t
                               permissions: #o644)
    (lambda (file)
      (display (teach-new-definition acro) file))))
;;;   (if (find-acronym acro)
;;;       (display "Acronym successfully learned")
;;;       (error "Sorry, I don't get it.")))

(define (teach-new-definition unk)
  (prompt-for-input *teach-new-prompt*)
  (string-append (object->string unk)
                 (string #\tab)
                 ;; can I achieve the desired effect with simpler code here?
                 ;;  (read-all
                 ;; (current-input-port) read-line)))
                 ;; returns a pair of strings
                 ;;
                 ;; If I solve issue #1 below, I will probably solve
                 ;; that problem
                 (read-line)))

;; issue #1: input for learning must be terminated by 
;; issue #2: sort the resulting acronyms file
;; issue #3: and make the LHS of the entry upper-case

(define *teach-new-prompt* "Type the new definition: ")

                                        ;  (display "This procedure also does nothing."))




;; the main procedures and accompanying global variables
(define (prompt-for-input string)
  (newline)
  (display string))
(define (iwtf-loop)
  (prompt-for-input *input-prompt*)
  (call-with-current-continuation
   (lambda (proc)
     (set! *top-level-cont* proc)
     (let* ((input (read))
            (output (and (not (eof-object? input))
                         (find-acronym input))))
       (cond (output
              (display output))
             ((eof-object? input)
              (newline)
              (display "Go on, clear off the lot of you!")
              (newline)
              (exit))
             (else (oops-message input))))
     (iwtf-loop))))

;; (print-form)
;; (print-page-end)


(let ((file *acro-file*))
  (if file
      (iwtf-loop)
      (error "No acronyms database found.")))

