;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: text-editor-expression-window.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: November 14, 2002 10:09:29
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Thursday, November 14, 2002 at 13:03:56 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :text-editor-case-display)

(defclass expression-glyph ()
  ((expression-comment :accessor expression-comment :initform nil :initarg :expression-comment
                       :documentation "The comment string associated with this expression")
   (expression-author :accessor expression-author :initform nil :initarg :expression-author
                      :documentation "The author of this expression")
   (expression-creation-time :accessor expression-creation-time :initform nil 
                             :initarg :expression-creation-time
                             :documentation "The time this expression was created")
   (expression :accessor expression :initform nil :initarg :expression
               :documentation "The raw lisp form of the expression")
   (pidgin-expression-form :reader pidgin-expression% :writer pidgin-expression-writer% :initform nil
                      :documentation "The pidginized form of the expression")
   (pprint-expression-form :reader pprint-expression% :writer pprint-expression-writer% :initform nil
                      :documentation "The prettyprinted form of the lisp expression")
   ))


(defun pidginize (expr)
  #+fire (fire::pidginize expr)
  #-fire expr)

;; I use the special reader/writer to keep things as quick as possible - in cases with
;;  lots (say hundreds) of expressions - they won't all be displayed at once - don't waste
;;  time computing the pidgin and pprint forms (which aren't uber fast anyway) - on expressions
;;  that aren't seen - and might not be seen for a while (if ever)

(defmethod pidgin-expression ((expr expression-glyph))
  (if (pidgin-expression% expr)
    (pidgin-expression% expr)
    (setf (pidgin-expression-writer% expr) (pidginize (expression expr)))))

(defmethod pprint-expression ((expr expression-glyph))
  (if (pprint-expression% expr)
    (pprint-expression% expr)
    (setf (pprint-expression-writer% expr) (pretty-print-to-string expr))))

(defun (setf pprint-expression) (val elem)
  (setf (pprint-expression-writer% elem) val))

(defun (setf pidgin-expression) (val elem)
  (setf (pidgin-expression-writer% elem) val))



(defclass expression-display-pane (cg:dialog)
  ((display-gridlines? :accessor display-gridlines :initform nil :initarg :display-gridlines?)
   (expressions :accessor expressions :initform nil :initarg :expressions
                :documentation "A list of the expression objects (each of type
                  expression-glyphs)")
   ))


(defmethod initialize-instance :after ((expr-pane expression-display-pane) &rest initargs)
  expr-pane)

(defun make-expression-display-window (&rest initargs &key (name :expr-display) 
                                             (background-color cg:white)
                                             (class 'expression-display-pane)
                                             (owner (cg:screen cg:*system*))
                                             &allow-other-keys)
  (let ((other-initargs (remove-keywords '(:class :name :background-color
                                             :owner) initargs)))
    (apply #'cg:make-window (append (list name                              
                                          :class class
                                          :owner owner
                                          :background-color background-color)
                                    other-initargs))))


(defmethod assign-expressions (expr-list (expr-pane expression-display-pane)
                                         &key (class 'expression-glyph))
  (mapcar #'(lambda (expr)
              (make-instance class 
                :expression expr)
      expr-list)))


 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code