;;;;	-------------------------------
;;;;	Copyright (c) 2001 Roger Corman
;;;;	All rights reserved.
;;;;	-------------------------------
;;;;
;;;;	File:		misc-utility.lisp
;;;;	Contents:	Corman Lisp miscellaneous features.
;;;;	History:	2/23/01  RGC  Created.
;;;;
(in-package :ccl)
(export 'ccl::get-command-line-args)

(defun parse-command-line (s)
	(flet ((is-white (c) (or (char= c #\space)(char= c #\tab)(char= c #\newline))))
		(let ((args '())
			  (state :white)
			  c
			  (tok '()))
			(dotimes (i (length s))
				(setf c (char s i))
				(case state
					(:white 
						(unless (is-white c)
							(if (char= c #\") 
								(setf state :in-quoted-token)
								(progn
									(setf state :in-token)
									(push c tok)))))
					(:in-quoted-token
						(cond ((char= c #\")
							   (progn
									(push (coerce (nreverse tok) 'string) args)
									(setf tok '())
									(setf state :white)))
							  (t (push c tok))))
					(:in-token
						(cond ((is-white c)
							   (push (coerce (nreverse tok) 'string) args)
							   (setf tok '())
							   (setf state :white))
							  (t (push c tok))))))
			(unless (null tok)
				(push (coerce (nreverse tok) 'string) args))
			(nreverse args)))) 

(defun ccl::get-command-line-args ()
	"Get the command line as alist of arguments, and remove any double-quotes
	 on the beginning or end of the strings."
	(let ((args (parse-command-line (win:get-command-line))))
		(mapcar 
			(lambda (x) 
				(if (char= (char x 0) #\")
					(setf x (remove #\" x :count 1)))
				(if (char= (char x (- (length x) 1)) #\")
					(setf x (remove #\" x :count 1 :from-end t)))
				x)
			args)))

;;; Some more ANSI stuff
;;;
;;;	Common Lisp VECTOR-POP function.
;;; From Pierpaolo BERNARDI, Karsten Poeck
;;;
(defun vector-pop (vector)
	(unless (array-has-fill-pointer-p vector)
		(error 
			(make-condition 'type-error :datum vector
				:expected-type '(satisfies array-has-fill-pointer-p))))
	(when (zerop (fill-pointer vector))
		(error "Can't pop an empty vector"))
	(aref vector (decf (fill-pointer vector))))