;;;
;;; scmail - a mail filter written in Scheme
;;;
;;; Copyright (C) 2002-2004 Satoru Takabayashi <satoru@namazu.org> 
;;;     All rights reserved.
;;;     This is free software with ABSOLUTELY NO WARRANTY.
;;;
;;; Permission to use, copy, modify, distribute this software and
;;; accompanying documentation for any purpose is hereby granted,
;;; provided that existing copyright notices are retained in all
;;; copies and that this notice is included verbatim in all
;;; distributions.
;;; This software is provided as is, without express or implied
;;; warranty.  In no circumstances the author(s) shall be liable
;;; for any damages arising out of the use of this software.
;;;

(define-module scmail.util
  (use file.util)
  (use srfi-13)
  (use gauche.parameter)
  (use scmail.config)
  (use scmail.progress)
  (use gauche.version)
  (export filter safe-rxmatch 
          scmail-check-gauche-version
          scmail-set-program-name!
          scmail-wformat scmail-eformat scmail-dformat
          scmail-not-implemented-error
          ))

(select-module scmail.util)

;;
;; FIXME: Reinvent it because filter in srfi-1 module is too
;; slow in old Gauche implementations.
;;
(define (filter predicate items)
  (let loop ((result '()) 
	     (items items))
    (cond ((null? items)
	   (reverse! result))
	  ((predicate (car items))
	   (loop (cons (car items) result) (cdr items)))
	  (else (loop result (cdr items))))))

;;; For avoiding errors while handling incomplete string
(define (safe-rxmatch pattern string)
    (with-error-handler
     (lambda (e) #f)
     (lambda ()
       (rxmatch pattern string))))


(define program-name (make-parameter #f))

(define (scmail-set-program-name! name)
  (program-name (sys-basename name)))


(define (scmail-xformat fmt . args)
  (if (program-name) (format (standard-error-port) "~a: " (program-name)))
  (apply format (standard-error-port) fmt args)
  (unless (eq? (string-ref fmt (- (string-length fmt) 1)) #\newline)
          (newline (standard-error-port))))

;; for warnings
(define (scmail-wformat fmt . args)
  (apply scmail-xformat fmt args))

;; for errors
(define (scmail-eformat fmt . args)
  (apply scmail-xformat fmt args)
  (exit 1))

;; for debugging (verbose mode)
(define (scmail-dformat fmt . args)
  (if (scmail-config-verbose-mode?)
      (apply scmail-xformat (string-append "debug: " fmt) args)))

(define (scmail-check-gauche-version)
  (let1 required-version "0.7.4.1"
        (if (version<? (gauche-version) required-version)
            (scmail-eformat "Gauche ~a or later is required" 
                            required-version))))

(define (scmail-not-implemented-error object method-name)
  (errorf "~a is not implemented for ~a" 
          method-name (class-name (class-of object))))

(provide "scmail/util")
