;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-

;;arbitrary number of sheets
;;  consists of named 2-dim array of data
;;  start with one at init
;;arbitrary number of grid window sets
;;  consists of set of windows pointing to sheets
;;  can save alone, or as an attribute of the set of sheets
;;  start with one, init to default sheet

;;grid-window is flavor of mouse-sensitive-typeout windows for spreadsheet grid display
;;grid-window database is list of all grid-windows that have been instantiated
;;  commands to create, delete, select one at a time
;;    default is full-outwin, optional select size / location
;;  add instance vars to grid-window flavor to keep all window state

;;window-set is a list of grid-windows with sizes and locations of each
;;window-set database is list of all window-sets
;;  commands to create, delete and select a window-set
;;  set is created by storing what is exposed (selectivly?)
;;    1. whole screen; 2. query each exposed window; 3. mark rectangle with mouse.
;;  deleting set just means deleting grid-window list entry from database
;;  selecting displays whole set
;;nice if it can be saved or at least recovered in proportional format
;;   so portrait and landscape are interchangable.

;;saving, loading sheets:
;;  save by sheet, set of sheets, grid-window or list-of-, or window-set or list-of.
;;    maybe sufficient to name sheets to save only by windows
;;      every sheet has a default grid-window
;;    maybe necessary to save sheets in separate files from each other and/or windows,
;;      so that independently edited window sets can share sheets.
;;      -- declare sheets as read-only; saved in separate files
;;  make list of sheets named by save-list
;;    build list of sheets used by each sheet by parsing all cells in sheet
;;  saving by window-set or set of window-sets:
;;    flexible heirarchy:
;;      top level: list of window-sets;
;;      window-set: named list of grid-windows; 
;;      grid-window: named window into a sheet; includes list of overriding column widths.
;;      sheet: array of spreadsheet data with default column widths.
;;         saved with list of other sheets referenced
;;  saving by sheet or list-of:
;;    just above line for list of sheets.
;;
;; file pointer from grid to sheet can be sheet in file or sheet in separate file,
;;   or sheet assumed to be in core.

;;function to get real column width from heirarch of 1. grid, 2. sheet, 3. default (for grid?)

;;save / load data: sheet or linked set of sheets
;;save / restore display parameters: one screen or set of screens



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

;;good: always just one command, editor and status window
;;  make arbitrary number of grid windows

;;should the windows be created at compile-time, or within a function?

(defvar *gridwin-alist* nil)

(defvar w nil)
(defvar old-w nil)

(defvar gridwin)
(defvar cmdwin)
(defvar edwin)
(defvar statwin)

(defvar portrait-split 700.)
(defvar landscape-split 800.)

(defun setup ()
  (when (null w)
    (setq w (make-instance 'spreadsheet-window))
    (push w old-w))
  (let ((screen-to-shrink
	  (do ((x *standard-output* (send x :superior))
	       (l nil (push x l)))
	      ((null x) (cadr l))
	    )))
    (multiple-value-bind (le te re be)
	(send tv:main-screen :edges)
      (cond
	((> be re)  ;;portrait
	 (send screen-to-shrink :set-edges le te re portrait-split)
	 (send w :set-edges le portrait-split re be))
	(t          ;;landscape
	 (send screen-to-shrink :set-edges re te landscape-split be)
	 (send w :set-edges landscape-split te re be))
	)))
  (setq gridwin (send w :get-pane 'grid-window)
	cmdwin (send w :get-pane 'command-window)
	edwin (send w :get-pane 'editor-window)
	statwin (send w :get-pane 'status-window))
  (send cmdwin :set-item-list command-alist)
  (send gridwin :set-item-type-alist *gridwin-alist*)
  (send w :expose)
  w)

;; hack spreadsheet
;; bobp

#|
The world consists of a set of two-dimensional arrays, segments
of which may be displayed in individual windows.  Each array cell
may contain an expression, which may be a numeric or string constant
or function.  

Cells are globally named by an array name and a cell local name or cell
relative or absolute array index, or locally named by a cell name or
array index.  Cell local names map into single cells, vectors, or
two-dimensional subsets of arrays.

Cell expression contents:
  Numeric constant, any valid lispm data type:
    Evaluates to itself; required for use in numeric expressions.
  String constant (art-string array):
    Evaluates to itself; causes error if referenced by numeric expression.
    Intended primarly for display of spreadsheet labels, but can also
    be referenced in expressions that expect a string.
  List:
    Eval is called.  May contain any valid Lisp expression that evaluates
    to a number or string.  
  FEF:
    Funcall.
  Forwarding:
    May reference an expression from another cell, as opposed to
    copying a value computed by another cell.

Referencing spreadsheet data:
simplest:
  (aref foo-array indices ...)
  Not capable of returning a sub-array (anything bigger than one cell).
better:
  (sref foo-array row-range col-range)
  Foo-array may be an array name, or nil for self.
  Row-range and col-range may be numbers, which may be integer constants
   or symbols that evaluate to constants, or a list of (from-index to-index),
   where from-index and to-index evaluate to constants or NIL for the
   lower and upper limits of the array, or the constant NIL for both
   limits of the array.
Examples:
  (+ 3 4) -> 7
  (- (sref gross

Editing / Entry:
  Two paths: cells and zmacs.
    Expressions can be entered as cell contents; the expressions can
    call arbitrary Lisp functions.  The functions are indepently
    managed in a separate editor buffer.
  Creating arrays:
  Creating windows:
  Defining functions:

Internal structure:
  Defstruct for arrays, with header info containing names and sizes.
  Symbol table for each array is attached in array header;
  maps names to zero, one and two-dimensional sub-arrays.
  List of functions from editor buffer.
alt: 3-dim array: 2 dimensions for row/col; 3rd has fixed slots
  for (0) expression, (1) timestamp, (2) names defined here,
    (3) display mode (format string), (4) my-index.

Loading / Saving:
  Arrays are dumped in ASCII list form, the same as in expression mode.
  List for an array has header that specifies names and sizes,
  including symbol table for names defined within.
  LISP functions saved in ASCII format, compiled as loaded?

Display capabilities:

Arbitrary windows, managed by existing system code.  Each window
shows a subset of a spreadsheet array.  For each window, the
contents of the array may be displayed as the unevaluated expressions,
or as the computed values.

Normal display mode is value, where each cell is evaluated and the
result is displayed.  Expression mode displays the cell contents
unevaluated.  Expression editing is normally done in value mode, in
which the expression for the currently selected cell is displayed in an
editor buffer.

Each array may be displayed by an arbitrary number of windows, but
each window may only display a contiguous two-dimentional subset of
one array.

Computation heirachy:

Default: For each cell, if not valid, evaluate it (recursive).
  References to other cells cause them to eval.
  What about recursive references?

Input: When one cell changes, invalidate (recursively) all cells that
  depend on it.  Every reference to a cell attaches a pointer from that
  cell to the cell that references it.  Pointers must be kept consistent
  when editing expressions.

Modes: Evaluate on every cell change vs. eval on command.

|#

(defvar command-alist
	(sortcar '(("Values" :value cmd-disp-values
		    :documentation "Display cell values")
		   ("Expressions" :value cmd-disp-expr
		    :documentation "Display cell expressions")
		   ("Formats" :value cmd-disp-format
		    :documentation "Display cell format strings")
		   ("Recomp Off" :value cmd-recomp-off
		    :documentation "Don't recompute")
		   ("Recomp On" :value cmd-recomp-on
		    :documentation "Recompute after every change")
		   ("Recompute" :value cmd-recomp
		    :documentation "Recompute just once")
		   ("Home" :value cmd-home
		    :documentation "Reposition this window to (0,0)")
		   ("Page Left" :value cmd-page-left
		    :documentation "Reposition window one screen-width left")
		   ("Page Up" :value cmd-page-up
		    :documentation "Reposition window one screen-height up")
		   ("Exit" :value cmd-exit
		    :documentation "Exit from spreadsheet")
		   )
		 #'string-lessp))

(defflavor spreadsheet-grid-window
	 ()
	 (tv:basic-mouse-sensitive-items
;;	  tv:process-mixin
	  tv:window))

(defflavor spreadsheet-window
	 nil
	 (tv:process-mixin
	  tv:bordered-constraint-frame-with-shared-io-buffer)
  (:default-init-plist
    :panes `((grid-window spreadsheet-grid-window
			    :blinker-p nil
			    :label nil
			    :more-p nil
			    :save-bits t)
	     (command-window tv:command-menu
			     :save-bits t
			     :item-list nil)
	     (editor-window tv:window ;;zwei:standalone-editor-frame
			    :blinker-deselected-visibility :off
			    :blinker-flavor tv:rectangular-blinker
			    :blinker-p t
			    :more-p nil
			    :label nil
			    :save-bits t)
	     (status-window tv:window
			    :blinker-p nil
			    :label nil
			    :more-p nil
			    :save-bits t))
    :constraints '((spreadsheet-window (grid-window
					 command-window
					 editor-window
					 status-window)
				       ((status-window 1 :lines)
					(editor-window 3 :lines)  ;;6
					(command-window 2 :lines))
				       ((grid-window :even)))))
  :gettable-instance-variables
  :settable-instance-variables
  :inittable-instance-variables)

(defmethod (spreadsheet-window :after :init) (&rest ignore)
  (funcall-self :set-selection-substitute (funcall-self :get-pane 'editor-window)))

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

(defstruct (cell :conc-name
		 (:type :named-array)
		 (:constructor make-cell
			       (sheet row col))
		 )
  expr          ;;cell expression
  value         ;;value computed from expression
  sheet         ;;sheet (array) this cell is in
  row           ;;index of this cell in its array
  col
  time          ;;timestamp: value is valid if time matches global timestamp
  names         ;;list of names defined here
  (format dfl-format)  	;;display format string (one-shot value, or ptr to a shared value)
  dependents	;;list of cells that reference this one
  )


(defstruct (window (:conc-name "WIN-")
		   (:type :named-array)
		   (:constructor make-window (&optional sheet start-col start-row mode))
		   )
  sheet	  	;;window displays from this array
  (start-col 0)	;;top-left corner starts displaying here
  (start-row 0)	;;
  (mode :value)	;;display mode; :value, :expr or :format
  )

;;only one of these per array
(defstruct (sheet :conc-name
		  (:type :named-array)
		  (:constructor make-empty-sheet))
  name          ;;name of this sheet
  array         ;;2-dim array for this sheet
  width         ;;array of column widths
  )

(defvar timestamp t)

(defvar window nil)

(defun setup-world ()
  (when (null window)
    (setq window (make-window)))
  (when (null (win-sheet window))
    (setf (win-sheet window) (make-sheet "world" 20 10)))
  )

(defvar dfl-width 10.)
(defvar dfl-format "~d")
(defvar format-format "~a")
(defvar expr-format "~a")

;;evaluate a cell
;; can this just be straight "eval"?

(defun cell-eval (cell)
  (if (eq (cell-time cell)
	  timestamp)
      (cell-value cell))
  (let* ((expr (cell-expr cell))
	 (value
	   (typecase expr
	     (null		;;empty cell is zero
	      0)
	     (number		;;number evaluates to itself
	      expr)
	     (string		;;string evaluates to itself
	      expr)
	     (list		;;list is an expression to apply or eval
	      ;(if (functionp (car expr))
		;  (apply (car expr) (cdr expr))
	      (eval expr))
	     (compiled-function
	      (funcall expr))
	     )
	   ))
    (setf (cell-time cell) timestamp)
    (setf (cell-value cell) value)))

;;display a window into an array
(defun redisplay (w)
  (let ((sheet (win-sheet w))
	max-row max-col)
    (send gridwin :clear-screen)

    ;;compute number of rows and cols that fit
    (multiple-value-bind (width height)
	(send gridwin :size-in-characters)
      (setq max-row (min (+ (win-start-row w) (1- height))
			 (array-dimension (sheet-array sheet) 0)))
      (do* ((c (win-start-col w) (1+ c))
	    (tot 0 (+ tot (or (aref (sheet-width sheet) c) dfl-width))))
	   ((or (<= (array-length (sheet-width sheet)) (1+ c))
		(> tot width)))
	(setq max-col c))
      (format t "~&w=~d h=~d nr=~d nc=~d" width height max-row max-col)
      )

    ;;display column headers
    (format gridwin "~&    ")
    (do ((col (win-start-col w) (1+ col)))
	((= col max-col))
      (send gridwin :item 'column-header (list w col)
	    "~Vd" (or (aref (sheet-width sheet) col) dfl-width) col)
      )
    
    ;;display each row
    (do ((row (win-start-row w) (1+ row)))
	((= row max-row))
      (send gridwin :item 'row-header (list w row)
	    "~&~3d " row)
      
      ;;display each column
      (do ((col (win-start-col w) (1+ col)))
	  ((= col max-col))
	(let ((cell (aref (sheet-array sheet) row col)))
	  (cond
	    (cell
	     (cell-eval cell)
	     (send gridwin :item 'cell (list w cell)
		   "~a" (cell-string cell w))
	     )
	    (t
	     (send gridwin :item 'empty-cell (list w row col)
		   "~V@T" (or (aref (sheet-width sheet) col) dfl-width)))
	    )
	  ))
      )))

;;return the actual string to print, already adjusted to the correct width.
;;the window indicates how long the string should be.
(defun cell-string (cell w)
  (let ((output-string
	  (cond
	    ((null cell)
	     "")
	    (t
	     (selectq (win-mode w)
	       (:value
		(format nil (cell-format cell) (or (cell-value cell) "")))
	       (:expr
		(format nil expr-format (or (cell-expr cell) "")))
	       (:format
		(format nil format-format (or (cell-format cell) "")))
	       (t
		(format nil "win-mode ~s" (win-mode w)))))
	    )))
    (let ((len (length output-string))
	  (max-len (or (aref (sheet-width (win-sheet w)) (cell-col cell)) dfl-width)))
      (if (> len max-len)
	  (substring output-string 0 max-len)
	(format nil "~V@t~a" (- max-len len) output-string))
      )))

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

(defun make-sheet (name nrows ncols)
  (let ((sheet (make-empty-sheet)))
    (setf (sheet-name sheet) name)
    (setf (sheet-array sheet) (make-array `(,nrows ,ncols)))
    (setf (sheet-width sheet) (make-array ncols))
    sheet
    ))

(defun change-sheet-dimensions (sheet nrows ncols)
  (let ((new-array (make-array nrows ncols))
	(new-width (make-array ncols)))
    (dotimes (c (min ncols (array-dimension (sheet-array sheet) 1)))
      (dotimes (r (min nrows (array-dimension (sheet-array sheet) 0)))
	(setf (aref new-array r c) (aref (sheet-array sheet) r c)))
      (setf (aref new-width c) (aref (sheet-width sheet) c))
      )
    (setf (sheet-array sheet) new-array
	  (sheet-width sheet) new-width)
    ))

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

;;what args should be passed to :MENU commands?
;;is raw item-list really what is passed to menu?

(deff s 'top-level-loop)

(defun top-level-loop ()
  (setup)
  (do-forever
    (redisplay window)
    
    (let ((blip (send gridwin :any-tyi)))
      (typecase blip
	(list
	 (selectq (car blip)
	   (:typeout-execute
	    (apply (cadr blip) (caddr blip)))
	   (:menu  ;;(:menu item-list mouse-mask cmd-window)
	    (when (eq (caddr (cadr blip)) 'cmd-exit)
	      (return nil))
	    (funcall (caddr (cadr blip)) window))
	   (t
	    (ferror nil "blip was ~s" blip))
	   ))
	(t
	 (ferror nil "blip was ~s" blip))
	))
    ))

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

;;selecting menu command
;;args: (window command-function)

;;display mode: value, expr, format
;;recompute on, off; recompute
;;home; page left, right, up, down

(defun cmd-disp-values (w)
  (setf (win-mode w) :value))

(defun cmd-disp-expr (w)
  (setf (win-mode w) :expr))

(defun cmd-disp-format (w)
  (setf (win-mode w) :format))

(defun cmd-home (w)
  (move-window w 0 0))

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

; window -> sheet -> array -> cell
; cell -> sheet

;;selecting existing cell
;;args: (window cell)

(tv:add-typeout-item-type *gridwin-alist* cell "Edit Cell" cell-cmd-edit-cell t
			  "Edit this cell")

(defun cell-cmd-edit-cell (window cell)
  (format t "~&edit cell: row=~d col=~d" (cell-row cell) (cell-col cell))
  (edit-cell cell)
  )

(tv:add-typeout-item-type *gridwin-alist* cell "Recompute Cell" cell-cmd-compute nil
			  "Compute value of this cell")

(defun cell-cmd-compute (window cell)
  (format t "~&compute cell: row=~d col=~d" (cell-row cell) (cell-col cell))
  (cell-eval cell))

(tv:add-typeout-item-type *gridwin-alist* cell "Edit Format" cell-cmd-edit-format nil
			  "Edit format string for this cell")

(defun cell-cmd-edit-format (window cell)
  (let ((new (zwei:pop-up-edstring (or (cell-format cell) "") '(:mouse) nil 700 30)))
    (when new
      (setf (cell-format cell) new))
    ))

(tv:add-typeout-item-type *gridwin-alist* cell "Move Window" cell-cmd-move-window nil
			  "Move window to have this cell in top-left")

(defun cell-cmd-move-window (window cell)
  (move-window window (cell-row cell) (cell-col cell)))

(tv:add-typeout-item-type *gridwin-alist* cell "Blank Cell" cell-cmd-blank nil
			  "Blank this cell")

(defun cell-cmd-blank (window cell)
  (format t "~&blank cell")
  ;;follow refs to do protocol

  ;;setf this cell's array slot to nil
  (setf (aref (sheet-array (cell-sheet cell)) (cell-row cell) (cell-col cell)) nil)
  )

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

;;selecting column header
;;args: (window column)

(tv:add-typeout-item-type *gridwin-alist* column-header "Change Width" col-cmd-width t
			  "Change width of this column")

(tv:add-typeout-item-type *gridwin-alist* column-header "Insert Column" col-cmd-insert nil
			  "Insert a new column here")

(tv:add-typeout-item-type *gridwin-alist* column-header "Delete Column" col-cmd-delete nil
			  "Delete this column")

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

;;selecting row header
;;args: (window row)

(tv:add-typeout-item-type *gridwin-alist* row-header "Row Header" row-cmd-nop t
			  "Do Nothing to this Row")

(defun row-cmd-nop (w row)
  (format t "~&row ~d" row))

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

;;selecting empty cell
;;args: (window row col)

; create new cell and edit it

(tv:add-typeout-item-type *gridwin-alist* empty-cell "Enter New Cell" ec-cmd-empty-cell t
			  "Enter new cell")

(defun ec-cmd-empty-cell (w row col)
  (let* ((array (sheet-array (win-sheet w)))
	 (cell (make-cell (win-sheet w) row col)))
    (setf (aref array row col) cell)
    (edit-cell cell)
    ))

(tv:add-typeout-item-type *gridwin-alist* empty-cell "Move Window" ec-cmd-move-window nil
			  "Move window to have this cell in top-left")

(defun ec-cmd-move-window (w row col)
  (move-window w row col))

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

;;stuff called by commands

(defun edit-cell (cell)
  (format t "~&edit cell")
  (let* ((old (format nil "~s" (cell-expr cell)))
	 (new (zwei:pop-up-edstring old '(:mouse) nil 700 30)))
    (when new
      (setf (cell-expr cell) (read-from-string new)))
    ))

(defun move-window (window row col)
  (format t "~&move window row=~d col=~d" row col)
  (when row
    (setf (win-start-row window) row))
  (when col
    (setf (win-start-col window) col))
  )