;;;; it-lookup.lisp
 
 (defpackage #:it-lookup-clim
   (:use #:clim #:clim-lisp #:it-lookup))
 
 (in-package #:it-lookup-clim)
 (declaim (optimize (debug 3)))
 
 (define-application-frame
   it-lookup ()
 
   ((results :initform (make-instance 'it-lookup::it-results :query "amicus") 
             :accessor results)
    (cursor :initform 0 :accessor cursor))
   (:pointer-documentation t)
   (:panes
     (app :application
          :height 400 :width 600
          :incremental-redisplay t
          :double-buffering t
          ;:display-time nil
          :display-function #'display-app
          )
     (int :interactor :height 100 :width 600))
   (:layouts
     (default (horizontally () app int))))
 
 (defun display-app (frame pane)
   (let ((history (stream-output-history pane)))
     (loop for element across (it-lookup::cases (results frame))
           do (add-output-record (with-output-to-output-record (pane)
                                   (terpri pane)   
                                   (it-lookup::format-result element pane)
                                   (terpri pane))
                                 history))
     (climacs-flexichain-output-history:change-space-requirements history) 
     (clim:replay history pane)))
 
 (define-presentation-type reference ())
 (defmethod it-lookup::format-reference :around ((it-case it-lookup::it-case)
                                                (stream clim:extended-output-stream))
   (clim:with-text-style (stream '(:serif :bold 16))
     (with-output-as-presentation (stream it-case 'reference)
       (call-next-method))))
 
 (defmethod it-lookup::format-reference :around ((it-case it-lookup::it-case)
                                                (stream sb-pretty:pretty-stream))
   (let ((real-stream (it-lookup::get-real-stream stream)))
     (terpri stream)
     (it-lookup::format-reference it-case real-stream)))
 
 (defun display-data (&rest args)
   (get-data))
 
 (defun get-data ()
   (return-from get-data)
   (let* ((pane (find-pane-named *application-frame* 'app))
          (history (stream-output-history pane)))
     (loop for element across (it-lookup::cases (results *application-frame*))
           for n from 0
           do (let ((record (clim:with-output-to-output-record (pane)
                              (it-lookup::format-result element pane)
                              (terpri pane))))
                #|(climb:ou history record n)|#))
     (climacs-flexichain-output-history:change-space-requirements history) 
     (clim:replay history pane)))
 
 (defclass no-clear-output-history (climacs-flexichain-output-history:flexichain-output-history)
   ())
 
 (defmethod clear-output-record ((h no-clear-output-history)))
 
 (defmethod generate-panes :after ((fm frame-manager) (frame it-lookup))
   (let ((*application-frame* frame))
     (let ((pane (clim:find-pane-named frame 'app)))
       (unless pane (break))
       (setf (clim:stream-recording-p pane) nil)
       (setf (clim:stream-end-of-line-action pane) :allow)
       (change-class (clim:stream-output-history pane)
                     ;'climacs-flexichain-output-history:flexichain-output-history
                     'no-clear-output-history
                     :parent pane))))
 
 (defun app-main ()
   (let* ((frame (make-application-frame 'it-lookup))
          (*application-frame* frame))
     (with-accessors ((results results)) frame
       (parse-results results
                      (run-query results)))
     (run-frame-top-level frame)))
 
 (define-it-lookup-command (com-inspect :name t) ()
   (clouseau:inspector
     (clim:stream-output-history
       (clim:find-pane-named clim:*application-frame* 'app))))
 
 (define-it-lookup-command (get-records :name t) ()
   (get-data))
 
 (define-it-lookup-command (com-quit :name t) ()
   (frame-exit *application-frame*))
 
 (defparameter *saved-cases* nil)
 (defun save-case (case) (push case *saved-cases*))
 
 (define-it-lookup-command (com-save :name t) ((it-case 'reference))
   (save-case it-case)
   it-case)
 
 (define-it-lookup-command (com-prev :name t) ()
   (let ((results (results *application-frame*)))
     (with-accessors ((page it-lookup::page)) results
       (when (> page 0)
         (decf page)))
     (parse-results results
                    (run-query results))))
 
 (define-it-lookup-command (com-next :name t) ()
   (let ((results (results *application-frame*)))
     (incf (it-lookup::page results))
     (parse-results results
                    (run-query results))))
 
 (setf mcclim-truetype:*truetype-font-path* "/Library/Fonts/")
 (app-main)