(in-package :clim-user)

(define-application-frame fold ()
  ()
  (:panes
   (io :interactor
    :height 50)
   (app :application
    :width 600
    :height 400
    :incremental-redisplay t
    :display-function 'fold-display
    :text-style (make-text-style :sans-serif :roman :small) ))
  (:layouts
   (default
       (vertically ()
         app
         io))))

(defun fold ()
  (run-frame-top-level(make-application-frame'fold)))

(defparameter *in* (open "/home/gilbert/IrcLog"))

(define-fold-command (com-foo :name "Foo") ()
  (setf *fodder* (nconc *fodder*
                        (list(read-line *in*)))))

(defparameter *fodder*
  (with-open-file (in "/home/gilbert/IrcLog")
    (loop repeat 101
          collect(read-line in))))

(defun fold-display (frame pane)
  (declare (ignorable frame pane))
  (print (STREAM-TEXT-MARGIN pane) *trace-output*)
  (finish-output *trace-output*)
  (with-end-of-line-action (*standard-output* :wrap)
    (let ((w(STREAM-TEXT-MARGIN pane)))
      (dolist (x *fodder*)
        (updating-output (*standard-output*
                          :unique-id x
                          :cache-value (cons x w)
                          :cache-test #'equal
                          )
                         (grind-line x))))))

(defun grind-line (x)
  (cond ((char= (char x 0) #\<)
         (let ((p (position #\> x)))
           (format *standard-output*
                   "~12<~A~>"(subseq x 0 (+ p 2)))
           (pprint-logical-block
            (*standard-output* nil)
            (loop for c across (subseq x (+ p 2)) do
                  (write-char c)
                  (when (char= c #\space)
                    (pprint-newline :fill))))))
        (t
         (with-drawing-options (*standard-output* :ink (make-gray-color .5))
           (write-string x))) )
  (terpri))