; by Alex Klinkhamer  (:handle grencez)
; Update: 2008.07.15
;  
;  Legal info:
; You may exploit this code,
;    and it may exploit you.
; I am not responsible for either.

;;;; NOTE - Whitespace is determined by
;;;; the :until value in do-next-chars
;;;; which is a space, tab, or newline
;;;; character by default.

(defmacro do-next-chars
  (((c &key ((:stream strm) *standard-input*)
      ((:until s-end-case) '(or #\Space #\Newline #\Tab)))
    . s-inits)
   (&rest s-results) . s-body)
  `(do ((,c (read-char ,strm nil #\Space)
            (read-char ,strm nil #\Space))
        ,@s-inits)
     ((case ,c
        (,s-end-case t)
        (otherwise nil))
      ,@s-results)
     ,@s-body))

;;; Read next string terminated by whitespace
(defmacro read-next-string
  (&key
    ((:stream istrm) *standard-input*)
    ((:until s-end-case) '(or #\Space #\Newline #\Tab)))
  (let ((c (gensym))
        (result-strm (gensym)))
    `(do-next-chars
       ((,c :stream ,istrm
            :until ,s-end-case)
        (,result-strm (make-string-output-stream)))
       ((values (get-output-stream-string ,result-strm)
                ;; Also return the last char read.
                ,c))
       (write-char ,c ,result-strm))))

;;; Streams' end reached?
(defun eofp (&optional (istrm *standard-input*))
  (handler-case
    (progn (peek-char nil istrm) nil)
    (end-of-file
      (condit)
      (declare (ignore condit))
      t)))

;;; List all whitespace-separated strings on the line.
(defmacro list-words
  (&key ((:stream istrm) *standard-input*)
        ((:until s-end-case) '(or #\Space #\Newline #\Tab)))
  (let ((str (gensym))
        (last-char (gensym)))
    `(unless (eofp ,istrm)
       (loop :with ,str :and ,last-char :do
             (multiple-value-setq
               (,str ,last-char) (read-next-string :stream ,istrm
                                                   :until ,s-end-case))
             :collect ,str
             :until (or (char= ,last-char #\Newline)
                        (eofp ,istrm))))))