;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: expression-editor-expression.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: August 27, 2002 10:13:02
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Thursday, August 29, 2002 at 14:00:19 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :textual-case-display)


(defclass editor-expression ()
  ((pprint-form :type string :accessor pprint-form :initform nil :initarg :pprint-form
                :documentation "A string pretty printed form of the expression - for display")
   (full-expr :accessor full-expr :initform nil :initarg :full-expr
              :documentation "The raw complete expression")
   (expression :accessor expression :initform nil :initarg :expression
               :documentation "The expression")
   (containing-expr :accessor containing-expr :initform nil :initarg :containing-expr
                    :documentation "The expr slot name of the expression containing this expression")
   ))


(defclass editor-main-expression ()
  ((expr-slots :accessor expr-slots :initform nil
               :documentation "An assoc list of slots with their values
                 This presents a flat access to every element of the expression")
   (expression :type editor-expression :accessor expression :initform nil
               :documentation "The expression contents")
   (pred-count :accessor pred-count :initform 0 
               :documentation "A counter for the number of predicates")
   (arg-count :accessor arg-count :initform 0 
              :documentation "A counter for the number of arguments")
   (position-count :accessor position-count :initform 0
                   :documentation "A counter for the position in the string form of
                     the expression where each element starts.")
   ))


(defclass expression-element ()
  ((value :accessor value :initform nil :initarg :value
          :documentation "The element of an expression")
   (name :accessor name :initform nil :initarg :name
         :documentation "The name of the expression element")
   (containing-expr :accessor containing-expr :initform nil :initarg :containing-expr
                    :documentation "The expr slot name of the expression containing this element")
   (element-original-pos :accessor element-original-pos :initform 0 :initarg :element-original-pos
                         :documentation "The position in the string representation of the expression
                        where this element starts - BEFORE adjusting for pretty printing")
   (element-position :accessor element-position :initform 0 :initarg :element-position
                     :documentation "The position in the string representation of the expression
                        where this element starts - adjusted for pretty printing")
   ))


(defclass expression-predicate (expression-element)
  (
   ))


(defclass expression-argument (expression-element)
  (   
   ))


(defun make-pred-name (main-expr)
  (intern (format nil "PRED~A" (incf (pred-count main-expr)))))

(defun make-arg-name (main-expr)
  (intern (format nil "ARG~A" (incf (arg-count main-expr)))))


(defun make-expression-predicate (pred calling-expr-slot main-expr)
  (let* ((elem-start (position-count main-expr))
         (new-pred (make-instance 'expression-predicate
                     :element-original-pos elem-start
                     :element-position elem-start
                     :containing-expr calling-expr-slot)))
    (setf (name new-pred) (make-pred-name main-expr))
    (setf (value new-pred) (if (listp pred)
                             (make-expression-expr pred (name new-pred) main-expr)
                             (progn
                               ;; need to increment the position counter by the length of our predicate (+ 1 space)
                               (incf (position-count main-expr) (1+ (length (format nil "~A" pred))))
                               pred)))
    (pushnew (cons (name new-pred) new-pred) 
             (expr-slots main-expr))
    new-pred))


(defun make-expression-arg (arg calling-expr-slot main-expr)
  (let* ((elem-start (position-count main-expr))
         (new-arg (make-instance 'expression-argument
                    :containing-expr calling-expr-slot
                    :element-original-pos elem-start
                    :element-position elem-start)))

    (setf (name new-arg) (make-arg-name main-expr))
    (setf (value new-arg) (if (listp arg)
                            (make-expression-expr arg (name new-arg) main-expr)
                            (progn 
                              ;; need to increment the position counter by the length of our argument (+ 1 space)
                              (incf (position-count main-expr) (1+ (length (format nil "~A" arg)))) 
                              arg)))
    (pushnew (cons (name new-arg) new-arg)
             (expr-slots main-expr))
    new-arg))


(defun make-expression-arguments (args calling-expr-slot main-expr)
  (mapcar #'(lambda (arg)
              (make-expression-arg arg calling-expr-slot main-expr))
    args))



(defun make-expression-expr (expr calling-expr-slot main-expr)
  (incf (position-count main-expr)) ;; need to increment the position for the open paren
  (let ((pred (make-expression-predicate (first expr) calling-expr-slot main-expr))
        (args (make-expression-arguments (rest expr) calling-expr-slot main-expr)))
    (incf (position-count main-expr)) ;; need to increment the position for the close paren
    (make-instance 'editor-expression 
      :pprint-form (pretty-print-to-string expr)
      :full-expr expr
      :expression (cons pred args)
      :containing-expr calling-expr-slot)))

    
(defun make-editor-expression (expr)
  (let ((main-expr (make-instance 'editor-main-expression)))
    (setf (expression main-expr)
      (make-expression-expr expr :main-expression main-expr))
    (adjust-spacing-for-pretty-printing main-expr)
    main-expr))



(defun make-default-editor-expression (calling-expr-slot main-expr)
  (let* ((pred (make-pred-name main-expr))
         (arg (make-arg-name main-expr))
         (pred-form (cg:read-from-string-safely (format nil "<~A>" pred)))
         (arg-form (cg:read-from-string-safely (format nil "<~A>" arg)))
         (expr (list pred-form arg-form))
         (pred-elem (make-instance 'expression-predicate 
                      :name pred
                      :value pred-form
                      :containing-expr calling-expr-slot))
         (arg-elem (make-instance 'expression-argument
                     :name arg
                     :value arg-form
                     :containing-expr calling-expr-slot)))
    (make-instance 'editor-expression
      :pprint-form (pretty-print-to-string expr)
      :full-expr expr
      :expression (list pred-elem arg-elem)
      :containing-expr calling-expr-slot)))


(defun make-generic-arguments (num-args calling-expr-slot main-expr)
  ;; returns 2 values - a list of argument names
  ;; and a list of element-argument objects
  ;; The number of themis determined by num-args
  (let ((argnames nil)
        (args nil))
    (dotimes (n num-args)
      (let* ((argname (make-arg-name main-expr))
             (arg-form (cg:read-from-string-safely (format nil "<~A>" argname)))
             (arg (make-instance 'expression-argument
                    :name argname
                    :value arg-form
                    :containing-expr calling-expr-slot)))
        (push arg-form argnames)
        (push arg args)))
    (values (nreverse argnames)
            (nreverse args))))

(defun make-specific-predicate-expression (pred arity calling-expr-slot main-expr)
  (let ((pred-elem (make-instance 'expression-predicate 
                     :name (make-pred-name main-expr)
                      :value pred
                     :containing-expr calling-expr-slot)))
    (multiple-value-bind (argnames args)
        (make-generic-arguments arity calling-expr-slot main-expr)
      (let ((expr (cons pred argnames)))
        (make-instance 'editor-expression
          :pprint-form (pretty-print-to-string expr)
          :full-expr expr
          :expression (cons pred-elem args)
          :containing-expr calling-expr-slot)))))


(defun make-initial-editor-expression ()
  (make-editor-expression '(data::<PRED1> data::<ARG1>)))


(defgeneric element-display-form (expr-elem)
  (:documentation "Returns a string representation of the expression element"))

(defmethod element-display-form ((expr-elem t))
  (format nil "~A" expr-elem))

(defmethod element-display-form ((expr-elem editor-expression))
  (pprint-form expr-elem))

(defmethod element-display-form ((expr-elem expression-element))
  (element-display-form (value expr-elem)))

(defmethod element-display-form ((expr-elem editor-main-expression))
  (element-display-form (expression expr-elem)))


(defun expr-slot-type (expr-slot)
  (cond ((equal "PRED" (subseq (symbol-name expr-slot) 0 4))
         :predicate)
        ((equal "ARG" (subseq (symbol-name expr-slot) 0 3))
         :argument)
        (t
         :main-expression)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Modification of the Expression

(defgeneric reconstruct-expression (expr &optional main-expr)
  (:documentation "Reconstructs the expression from the expression slot 
     values.  This replaces the assoc list in expr-slots as well as the
     display forms for each of the elements of the expression. This
     is intended to be used when a portion of the expression is 
     replaced with something new"))

(defmethod reconstruct-expression ((expr t) &optional main-expr)
  (incf (position-count main-expr) (1+ (length (format nil "~A" expr))))
  expr)

(defmethod reconstruct-expression ((expr expression-element) &optional main-expr)
  (pushnew (cons (name expr) expr) (expr-slots main-expr))
  (setf (element-original-pos expr) (position-count main-expr))
  (setf (element-position expr) (position-count main-expr))
  (reconstruct-expression (value expr) main-expr))



(defmethod reconstruct-expression ((expr list) &optional main-expr)
  (mapcar #'(lambda (exp)
              (reconstruct-expression exp main-expr))
    expr))

(defmethod reconstruct-expression ((expr editor-expression) &optional main-expr)
  (incf (position-count main-expr)) ;; incf for open-paren
  (let ((new-full-expr (reconstruct-expression (expression expr) main-expr)))
    (incf (position-count main-expr)) ;; incf for close-paren
    (setf (full-expr expr) new-full-expr)
    (setf (pprint-form expr) (pretty-print-to-string new-full-expr))
    new-full-expr))
  
(defmethod reconstruct-expression ((expr editor-main-expression) &optional main-expr)
  (declare (ignore main-expr))
  (setf (expr-slots expr) nil)
  ;; set to -1 to take care of the very first paren not having a space in front of it
  (setf (position-count expr) 0)  
  (reconstruct-expression (expression expr) expr)
  (adjust-spacing-for-pretty-printing expr))

;;;;;;;;;;;;;


(defmethod make-new-expression-value ((new-val list) calling-expr-slot main-expr)
  (make-expression-expr new-val calling-expr-slot main-expr))

(defmethod make-new-expression-value ((new-val t) calling-expr-slot main-expr)
  (declare (ignore calling-expr-slot main-expr))
  new-val)

(defun replace-element (expr-slot new-value main-expr)
  (let ((new-elem (make-new-expression-value new-value expr-slot main-expr)))
    (setf (value (cdr (assoc expr-slot (expr-slots main-expr)))) new-elem)
    (reconstruct-expression main-expr)))



(defun replace-expression (new-expr main-expr)
  (setf (expression main-expr) new-expr)
  (reconstruct-expression main-expr))

;;;;;;;;;;;;;;;;;

(defun find-all-positions (item str)
  (let ((positions nil))
    (with-input-from-string (s str)
      (do ((c (read-char s nil 'done) (read-char s nil 'done))
           (index 0 (incf index)))
          ((eq c 'done) positions)
        (when (eq item c)
          (push index positions))))
    (nreverse positions)))


(defmethod first-term ((elem t))
  (format nil "~A" elem))

(defmethod first-term ((elem editor-expression))
  "")

(defun adjust-expr-positions (pos main-expr)
  (dolist (slot (expr-slots main-expr))
    (let* ((elem (cdr slot))
           (orig-pos (element-position elem)))
      (when (or (>= orig-pos pos)
                (and (< orig-pos pos)
                     (> (+ orig-pos (length (first-term (value elem)))) 
                        (1+ pos))))
        (incf (element-position (cdr slot)) 2)))))

(defun adjust-spacing-for-pretty-printing (main-expr)
  ;; Since pretty printing will introduce newlines I need to go back 
  ;;  and adjust the element-position values in the expression 
  ;;  to reflect the new position (each newline counts as TWO spaces
  ;;  not 1 - this is because when doing set-selection in text-edit-panes
  ;;  they count as 2, as opposed to the search over sequences function
  ;;  treating them as one... wish it would be consistent but no...)
  ;; For each newline go through each element that starts on or after the
  ;;  position of that newline and increment by 2
  (let ((newline-poss (find-all-positions #\newline (pprint-form (expression main-expr))))
        (incr 0))
    (dolist (pos newline-poss)
      (adjust-expr-positions (+ pos incr) main-expr)
      (incf incr)))
  main-expr)
  


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