; -*- Lisp -*-
; utilities: an EuLisp utility library and euscheme/EuLisp
; compatability layer
;
; Copyright (c) 2001 Ian Hickson <ian@hixie.ch>
;
; 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., 675 Mass Ave, Cambridge, MA 02139, USA.

(defmodule utilities
  (import (; get around a bug in euscheme so that we can use strict eulisp:
           (rename ((<char> <character>)
                    (charp characterp))
                   level0)))

  ; the (member) method on <collection> doesn't return the member that
  ; matches, so we have to make our own function to search for the
  ; items. The function's signature is modelled on (member).
  (defun grep (object list test)
    (if (eq list ())
        () ; didn't find it, return nil
      (if (test (car list) object)
          (car list) ; found it, return the object that matched
        (grep object (cdr list) test)))) ; loop

  ; we sometimes need to compare characters to strings, so we define a
  ; method on <character> to allow that.
  (defmethod equal ((character <character>) (string <string>))
    (equal (convert character <string>) string))

  ; similarly for two characters
  (defmethod equal ((character1 <character>) (character2 <character>))
    (equal (convert character1 <string>) (convert character2 <string>)))

  ; an interesting omission in EuLisp (or apparent omission, maybe I
  ; missed something) is the lack of a function to slice an ordered
  ; collection (e.g., return a list containing elements 0 to n-2)
  (defun slice (list from to)
    (if (> from to) () ; return nil at the end to make a proper list
      ; for the others, loop using use tail recursion
      (cons (element list from) (slice list (+ from 1) to))))

  ; the specific case of returning all but the last item is common
  ; enough to warrant its own shorthand
  (defun pop (list)
    (slice list 0 (- (size list) 2)))


  ; Another EuLisp omission is the equivalent of perl's split().
  ;
  ; This takes a string and returns a list of strings, being the
  ; original string |string|, starting at |start| and split each time
  ; |test| returns true when an element is passed to it along with
  ; |search|.
  ;
  ; For instance, splitting "foo bar baz" on #\space using (equal) and
  ; starting at 0 would return ("foo" "bar" "baz").
  ;
  (defun split (string search test start)
    (split-string string search test start start))

  ; note: this uses (substring), which is an euscheme extension to
  ; EuLisp. EuLisp doesn't have very good string handling... :-(
  (defun split-string (string search test start index)
    (if (>= index (size string))
        (if (> index start)
            (list (substring string start index)))
      (if (test (element string index) search)
          (if (> index start)
              (concatenate (list (substring string start index)) (split-string string search test (+ index 1) (+ index 1)))
            (split-string string search test (+ index 1) (+ index 1)))
        (split-string string search test start (+ index 1)))))

  ; remove duplicates from a list
  (defun remove-duplicates-internal (uniques remainder)
    (if (eq remainder ())
        uniques
      (if (member (car remainder) uniques)
          (remove-duplicates-internal uniques (cdr remainder))
        (remove-duplicates-internal (cons (car remainder) uniques) (cdr remainder)))))

  (defun remove-duplicates (list)
    (remove-duplicates-internal () list))


  ;; Program Argument Processing
  ;
  ; This routine returns a list of the arguments present on the
  ; command line. Each entry in the list returned is itself a list.
  ;
  ; For example, for the following command line:
  ;    $ foo 'a test' -qd 1 -f bar baz
  ; ...then:
  ;    (process-arguments)
  ; ...returns:
  ;    (("a test") ("-q") ("-d" 1) ("-f" "bar" "baz"))
  ;
  ; Note. This function uses euscheme-specific extensions to EuLisp,
  ; namely, (getarg).
  ;
  ; (XXX See note below -- because of a bug in euscheme, we use '=' as
  ; the prefix instead of '-'.)
  ;
  (defun process-arguments ()
    ; start at 1 to skip program name which is argument 0
    (collapse-argument-list (expand-argument-list 1)))

  ; expands a list of strings (getarg) into a list of lists
  (defun expand-argument-list (index)
    (let ((argument (getarg index))) ; XXX non-portable XXX
      (if argument
          (concatenate (expand-argument argument) (expand-argument-list (+ index 1))))))

  (defun expand-argument (argument)
    (if (and (> (size argument) 1)
             ; Look for a '-' as a sign of an argument list
             ;
             ; XXX Except that a bug in euscheme means that this won't
             ; work, because euscheme only passes arguments that start
             ; with characters other than '-' to the executing program.
             ;
             ; Therefore, for now, use '=' as the argument indicator.
             (equal (element argument 0) #\=))
        ; this is an argument list
        (expand-argument-string argument 1)
      ; this is just a string, return that
      (list argument)))

  (defun expand-argument-string (argument index)
    (if (< index (size argument))
        (cons (element argument index) (expand-argument-string argument (+ index 1)))))

  ; takes a list of arguments and collects lists of arguments that
  ; don't start with "-" (those that do will be <character> objects
  ; because of the use of (element) in (expand-argument-string) above)
  (defun collapse-argument-list (arguments)
    (let ((result ())
          (current ()))

      ; the loop
      ; this works backwards so that we can use (cons)
      (defun collapse-argument (index)
        (if (< index 0)
            (progn
              ; we're all done
              ; if there's anything in current, push it onto the result:
              (if current
                  (setq result (cons current result)))
              ; now return the result
              result)
          ; not finished: ok, do argument index
          (let ((argument (element arguments index)))
            (if (characterp argument)
                (progn ; it's an argument of the -a form
                  ; shift what we have so far into the result list
                  (setq result (cons (cons argument current) result))
                  ; reset the current list
                  (setq current ()))
              ; it's a string argument (file name or something)
              ; shift it onto the list representing the current argument
              (setq current (cons argument current)))
            ; do the rest of the arguments
            (collapse-argument (- index 1)))))

      ; start the loop
      (collapse-argument (- (size arguments) 1))))

  (export grep
          slice
          pop
          split
          remove-duplicates
          process-arguments ; euscheme-specific
          <character> ; export our euscheme bug workaround
          characterp) ; export our euscheme bug workaround
  ; XXX in non-euscheme EuLisp environments, we'd have to implement
  ; our own (substring) and export it here
)