(in-package :clim-doc)

(defconstant +nbsp+ (code-char 160))

;;;; Tracking-Stream

(defclass tracking-stream (fundamental-input-stream fundamental-character-stream)
  ((stream :initarg :stream)            ;the stream the data is comming from
   (column :initform 0)                 ;current column
   (line   :initform 0)                 ;current line number
   (buf    :initform nil)               ;a buffer (holding a line)
   (lookahead :initform nil)            ;a possible unread char
   (filename :initform nil :initarg :filename) ))

(defmethod stream-read-char ((self tracking-stream))
  (with-slots (stream column line lookahead buf filename) self
    (cond (lookahead
           ;; try the lookahead
           (prog1 lookahead (setf lookahead nil)))
          (t
           (cond
             ((null buf)
              ;; no line in buffer present, read a line and try again
              (setf buf (read-line stream nil :eof)
                    column 0)
              (and (stringp buf) (setf buf (untabify-string buf)))
              (incf line)
              (stream-read-char self))
             ((eq buf :eof)
              ;; eof reached
              :eof)
             ((= (length buf) column)
              ;; we are at the newline character of the line
              (setf buf nil)
              #\newline)
             (t
              (prog1
                  (char buf column)
                (incf column))) )))))

(defmethod stream-unread-char ((stream tracking-stream) character)
  (with-slots (lookahead) stream
    (setf lookahead character)))

(defmethod show-current-position ((stream tracking-stream) output)
  "Shows the current stream position in an interactive fashion."
  (with-slots (buf column) stream
    (format output "~&~A~%~vT^" buf (1- column)))
  (values))

(defun untabify-string (string &optional (tab-size 8))
  (with-output-to-string (sink)
    (let ((x 0))
      (map nil (lambda (ch)
                 (cond ((char= ch #\Tab)
                        (write-char #\space sink)
                        (incf x)
                        (do () ((= 0 (mod x tab-size))) 
                          (write-char #\space sink)
                          (incf x)))
                       ((char= ch #\newline)
                        (write-char ch sink)
                        (setf x 0))
                       (t
                        (write-char ch sink)
                        (incf x))))
           string))))

(defun split-sequence-if (output-type-spec predicate sequence &key (start 0) (end (length sequence)))
  (let ((current nil)
        (res nil))
    (loop for i from start below end do
      (cond ((funcall predicate (elt sequence i))
             (push (coerce (reverse current) output-type-spec) res)
             (setf current nil))
            (t
             (push (elt sequence i) current))))
    (reverse (cons (coerce (reverse current) output-type-spec) res)) ))

(defun escape-string-for-shell (str)
  (with-output-to-string (bag)
    (loop for c across str do
          (cond ((or (alpha-char-p c) (digit-char-p c)
                     (find c ".,:-_/%^"))
                 (write-char c bag))
                (t
                 (write-char #\\ bag)
                 (write-char c bag))))))

(defun curry (fun &rest args)
  #'(lambda (&rest more)
      (apply fun (append args more))))

(defun white-space-p (x)
  (or (char= x #\space) 
      (char= x #\newline)
      (char= x #\page)))

