; The LAML library and programs written by Kurt Normark, Aalborg University, Denmark.
; Copyright (C) 1999  Kurt Normark.
;
; 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 2 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.
;
; You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


;;;; .title Reference Manual of the MzScheme LAML compatibility libray.
;;;; MzScheme specific stuff to be loaded for compatibility. 
;;;; This file implements each of the necessary non-R5RS functions mentioned in the
;;;; root documentation of the LAML system. Notice that some of the non-standard Scheme functions used
;;;; in LAML already happens to exist in MzScheme. These are 
;;;; file-exists?, delete-file, copy-file, and directory-exists?
;;;; Therefore, these functions need not to be provided in this compatibility library. 
(require (lib "compat.ss"))
(require (lib "url.ss" "net"))

;;; Definition of non-R5RS Scheme functions. 
;;; The functions in this section are general purpose functions which happen
;;; not to be in the Scheme standard (R5RS). 
 
(define (current-time)
  (current-seconds))

 
(define (sort-list list com)
  (if (null? list) list (sort com list)))


 
(define (make-directory-in-directory in-directory-path new-dir)
  (make-directory (string-append in-directory-path new-dir)))

 
(define (mail receiver title contents)
  (error "The mail function is not implemented in this configuration"))


; -----------------------------------------------------------------------------

 
(define (bound? symbol)
  (if (memq symbol (namespace-mapped-symbols)) #t #f))

 
(define eval-cur-env eval)

; Version 29: Does not work fully correct. Reports success for existing server but non-existing file.
; (define (url-target-exists? url-string)
;  (with-handlers ((exn?
;                     (lambda (exn) #f)))
;     (let ((ip (get-pure-port (string->url url-string))))
;       (close-input-port ip)
;       #t)))

 
(define (url-target-exists? url-string)
  (let* ((result (read-http-alist url-string))
         (status (as-number (defaulted-get 'status result "0"))))
    (cond ((and (>= status 200) (<= status 399)) #t)
          (else #f))))


;;; LAML specific, context definition functions. 
;;; The functions in this section return and define the activation context of the LAML processor.

 
(define (laml-canonical-command-line)
  (if (and (vector? argv) (>= (vector-length argv) 2))
        (list 'laml 
               (file-name-proper (vector-ref argv 0))
               (transliterate (vector-ref argv 1) #\\ "/") ; ensure forward slashing
               (if (>= (vector-length argv) 3) (cddr (vector->list argv)) '())   ; Before august 18, 2008:  (if (>= (vector-length argv) 3) (vector-ref argv 2))
; Playing with: (if (>= (vector-length argv) 3) (cddr (vector->list argv)) '())
        )
      #f))


 
(define (fake-startup-parameters source-file startup-dir . program-parameters)
  (set! argv (list->vector (append (list source-file startup-dir) program-parameters))))

; Earlier version:
; (define (fake-startup-parameters source-file startup-dir . optional-parameter-list)
;   (let ((program-parameters (optional-parameter 1 optional-parameter-list '()))
;         (a (make-vector 3 #f)))
;     (vector-set! a 0 source-file)
;     (vector-set! a 1 startup-dir)
;     (vector-set! a 2 program-parameters)
;     (set! argv a)))


(error-print-width 1000)

(read-case-sensitive #t)