[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Spreadsheet-like editor?
- To: info-mcl@ministry.cambridge.apple.com
- Subject: Re: Spreadsheet-like editor?
- From: eliot@cs.umass.edu (CHRISTOPHER ELIOT)
- Date: 6 Dec 1993 13:16 EST
- Distribution: world
- News-software: VAX/VMS VNEWS 1.41
- Newsgroups: comp.lang.lisp.mcl
- Organization: University of Massachusetts CS Department
- References: <93Dec6.105428est.144002@explorer.dgp.toronto.edu>
In article <93Dec6.105428est.144002@explorer.dgp.toronto.edu>, markt@dgp.toronto.edu ("Mark A. Tapia") writes...
>On Friday 03 DEC, Peter Szolovits writes:
> Someone somewhere must surely have written some code they would like to share
> that displays a table of values and allows the user to select individual table
> entries and edit them in-place. I looked on the CD-ROM but could not find one.
Hello Peter!
I started such a beast. This is very unfinished, it uses a fixed size
array and does not handle things like arrow keys and such but it has
some minimal spreadsheet functionality. You can reference a cell
using the form (cell x y) or (rcell dx dy) for a relative reference.
Here is the code:
;;;
;;; Spreadsheet.lisp
;;;
#|
================================================================
Purpose ========================================================
================================================================
???
================================================================
Status =========================================================
================================================================
In-progress.
================================================================
Change history =================================================
================================================================
16-Oct-93 cre Created.
|#
(in-package "COMMON-LISP-USER")
(defvar *spreadsheet-data*)
(defvar *cell-x*)
(defvar *cell-y*)
(defclass formula ()
((owner
:initarg :owner
:reader owner)
(formula
:initform 0
:accessor formula)
(value
:initform 0
:accessor value)
(cell-error
:initform nil
:accessor cell-error)
(cell-format
:initform nil
:accessor cell-format)
(cell-x
:initarg :cell-x
:reader cell-x)
(cell-y
:initarg :cell-y
:reader cell-y)))
#|(defun make-zero-array (width height)
(make-array (list width height) :initial-element 0))|#
(defun make-empty-spreadsheet (width height)
(let ((data (make-array (list width height))))
(loop for i from 0 below width
do (loop for j from 0 below height
do (setf (aref data i j)
(make-instance 'formula
:cell-x i
:cell-y j))))
data))
(defclass spreadsheet-dialog-item (SEQUENCE-DIALOG-ITEM)
()
(:default-initargs
:CELL-SIZE #@(75 16)
:view-nick-name :worksheet
:SELECTION-TYPE :contiguous
:TABLE-DIMENSIONS #@(5 4)
:table-print-function 'table-print-cell
:TABLE-HSCROLLP T
:TABLE-VSCROLLP T))
(defmethod view-click-event-handler :after ((self spreadsheet-dialog-item)
where)
(let ((c (point-to-cell self where)))
(unless (null c)
(open-cell (view-container self) (point-h c) (point-v c)))))
(defmethod cell-contents ((self spreadsheet-dialog-item) x &optional y)
(let ((window (view-container self)))
(let ((array (formulas window)))
(let ((cell (if (null y)
(aref array (point-h x) (point-v x))
(aref array x y))))
cell))))
(defclass spreadsheet-window (dialog)
((show-formulas
:accessor show-formulas
:initform nil)
(formulas
:reader formulas
:initform #|(make-empty-spreadsheet 25 16)|#
(make-array (list 25 16)))
(attached-windows
:accessor attached-windows
:initform nil)
)
(:default-initargs
:WINDOW-TYPE :DOCUMENT-WITH-ZOOM
:VIEW-POSITION :CENTERED
:VIEW-SIZE #@(600 400)
:VIEW-FONT '("Chicago" 12 :SRCOR :PLAIN)
:VIEW-SUBVIEWS
(LIST (MAKE-DIALOG-ITEM 'BUTTON-DIALOG-ITEM
#@(370 6) #@(62 16) "Open"
'open-cell-fn :DEFAULT-BUTTON NIL)
(MAKE-DIALOG-ITEM
'BUTTON-DIALOG-ITEM
#@(370 35) #@(60 16)
"Enter" 'spreadsheet-enter-fn
:view-nick-name :enter
:DEFAULT-BUTTON T)
(MAKE-DIALOG-ITEM
'BUTTON-DIALOG-ITEM
#@(440 35) #@(60 16)
"Cancel" 'spreadsheet-cancel-fn
:view-nick-name :cancel)
(MAKE-DIALOG-ITEM
'RADIO-BUTTON-DIALOG-ITEM
#@(140 5) #@(80 16)
"Formulas"
#'(lambda (item)
(let ((window (view-container item)))
(setf (show-formulas window) t)
(redraw window)))
:RADIO-BUTTON-CLUSTER :SHOW)
(MAKE-DIALOG-ITEM
'RADIO-BUTTON-DIALOG-ITEM
#@(230 5) #@(80 16)
"Values"
#'(lambda (item)
(let ((window (view-container item)))
(setf (show-formulas window) nil)
(redraw window)))
:RADIO-BUTTON-PUSHED-P T
:RADIO-BUTTON-CLUSTER :SHOW)
(MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(80 35) #@(280 16)
"0" NIL
:ALLOW-RETURNS NIL
:view-nick-name :entry)
(MAKE-DIALOG-ITEM 'STATIC-TEXT-DIALOG-ITEM
#@(2 35) #@(75 16) "" NIL
:view-nick-name :cell-label)
(MAKE-DIALOG-ITEM
'spreadsheet-dialog-item
#@(0 60) #@(600 340)
"" NIL
:CELL-SIZE #@(75 16)
:view-nick-name :worksheet
))))
(defmethod initialize-instance :after ((self spreadsheet-window) &key)
(let ((formulas (formulas self)))
(let ((dimensions (array-dimensions formulas)))
(dotimes (i (first dimensions))
(dotimes (j (second dimensions))
(let ((value (aref formulas i j)))
(when value
(setf (slot-value value 'owner) self)))))
(set-table-dimensions (view-named :worksheet self)
(first dimensions) (second dimensions)))))
(defmethod window-close :before ((self spreadsheet-window))
(dolist (window (attached-windows self))
(window-close window)))
(defmethod recalculate ((self spreadsheet-window)
&optional (start-x 0) (start-y 0))
(let ((formulas (formulas self))
(table (view-named :worksheet self)))
(let ((size (array-dimensions formulas)))
(let ((*cell-x* nil)
(*cell-y* nil)
(*spreadsheet-data* formulas))
(loop for x from start-x below (first size)
do (setq *cell-x* x)
do (loop for y from start-y below (second size)
for cell = (aref formulas x y)
do (setq *cell-y* y)
do (when cell
(multiple-value-bind
(value error)
(ignore-errors (eval (formula cell)))
(cond ((null error)
(setf (cell-error cell) nil)
(setf (value cell) value))
(t (setf (value cell) error)
(setf (cell-error cell) t))))
(redraw-cell table x y))))))))
(defmethod redraw ((self spreadsheet-window)
&optional (start-x 0) (start-y 0))
(let ((size (array-dimensions (formulas self)))
(table (view-named :worksheet self)))
(loop for x from start-x below (first size)
do (setq *cell-x* x)
do (loop for y from start-y below (second size)
do (redraw-cell table x y)))))
(defun table-print-cell (cell stream)
(when (and cell (slot-boundp cell 'owner))
(let ((window (owner cell)))
(cond ((show-formulas window)
(write (formula cell) :stream stream))
((cell-format cell)
(format stream (cell-format cell) (value cell)))
(t (write (value cell) :stream stream))))))
(defun ensure-cell-exists (window x y)
(let ((formulas (formulas window)))
(when (null (aref formulas x y))
(setf (aref formulas x y)
(make-instance 'formula
:owner window
:cell-x x
:cell-y y)))))
(defun open-cell (window x y)
(let ((entry (view-named :entry window))
(label (view-named :cell-label window)))
(let ((formulas (formulas window)))
(let ((value (aref formulas x y)))
(if (null value)
(set-dialog-item-text entry "")
(set-dialog-item-text entry (format nil "~s" (formula value))))
(select-all entry)
(set-dialog-item-text
label
(format nil "c[~a,~a]" x y))))))
(defun open-cell-fn (item)
(let ((window (view-container item)))
(let ((entry (view-named :entry window)))
(let ((select (first (selected-cells (view-named :worksheet window)))))
(when select
(let ((x (point-h select))
(y (point-v select)))
(ensure-cell-exists window x y)
(make-cell-editor
(aref (formulas window) x y)))
)))))
(defun parse-spreadsheet-formula (text)
(if (every #'whitespacep text)
0
(read-from-string text
nil :error)))
(defun spreadsheet-enter-fn (item)
(let ((window (view-container item)))
(let ((entry (view-named :entry window)))
;; We should parse the form specially here.
(let ((form (parse-spreadsheet-formula
(dialog-item-text entry)))
(formulas (formulas window)))
(cond ((eq form :error) (ccl::beep))
(t (dolist (pt (selected-cells
(view-named :worksheet window)))
(let ((x (point-h pt))
(y (point-v pt)))
(ensure-cell-exists window x y)
(setf (formula (aref formulas x y)) form)))
(set-dialog-item-text entry "")
(recalculate window)
))))))
(defun spreadsheet-cancel-fn (item)
(let ((window (view-container item)))
(let ((entry (view-named :entry window))
(enter (view-named :enter window)))
(set-dialog-item-text entry "")
;(dialog-item-disable enter)
;(dialog-item-disable item)
)))
(defun make-spreadsheet ()
(make-instance 'spreadsheet-window
:window-title "Spreadsheet"))
(defun cell (x y)
(let ((dimensions (array-dimensions *spreadsheet-data*)))
(cond ((or (< x 0) (< y 0))
(error "Illegal Cell Reference"))
((or (> x (first dimensions)) (> y (second dimensions)))
(error "Illegal Cell Reference"))
((null (aref *spreadsheet-data* x y))
;; default non-existent cell value.
0)
(t (value (aref *spreadsheet-data* x y))))))
(defun rcell (dx dy)
(cell (+ dx *cell-x*) (+ dy *cell-y*)))
;;;;;;;;;;;;;;;;;;;
;;; Cell Editor ;;;
;;;;;;;;;;;;;;;;;;;
(defclass cell-editor-dialog (dialog)
((editing-cell
:initarg :editing-cell
:reader editing-cell))
(:default-initargs
:WINDOW-TYPE :DOCUMENT
:WINDOW-TITLE "Cell Editor"
:VIEW-POSITION '(:LEFT 99)
:VIEW-SIZE #@(374 280)
:VIEW-FONT '("Chicago" 12 :SRCOR :PLAIN)
:VIEW-SUBVIEWS
(LIST (MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(5 10) #@(224 95)
""
nil
:view-nick-name :formula
:ALLOW-RETURNS t)
(MAKE-DIALOG-ITEM 'BUTTON-DIALOG-ITEM #@(284 251) #@(62 16)
"OK" 'cell-editor-ok-fn
:DEFAULT-BUTTON T)
(MAKE-DIALOG-ITEM 'BUTTON-DIALOG-ITEM
#@(196 250) #@(62 16)
"Cancel"
'cell-editor-cancel-fn
:DEFAULT-BUTTON NIL)
(MAKE-DIALOG-ITEM
'SEQUENCE-DIALOG-ITEM
#@(241 8) #@(132 99) "" 'NIL
:CELL-SIZE #@(116 16)
:SELECTION-TYPE :SINGLE
:TABLE-HSCROLLP NIL
:TABLE-VSCROLLP T
:TABLE-SEQUENCE '("~s" "~2,2d"))
(MAKE-DIALOG-ITEM 'STATIC-TEXT-DIALOG-ITEM
#@(3 119) #@(228 18)
"0" 'NIL
:view-nick-name :value)
)))
(defun string-left-trim-white (string)
(string-left-trim
"
"
string))
(defun make-cell-editor (cell)
(let ((dialog (make-instance 'cell-editor-dialog
:editing-cell cell)))
(set-dialog-item-text
(view-named :formula dialog)
(string-left-trim-white
(with-output-to-string (stream)
(pprint (formula cell) stream))))
(set-dialog-item-text
(view-named :value dialog)
(string-left-trim-white
(with-output-to-string (stream)
(pprint (value cell) stream))))
(select-all (view-named :formula dialog))
(push dialog (attached-windows (owner cell)))
dialog))
(defun cell-editor-close (dialog)
(let ((sheet (owner (editing-cell dialog))))
(setf (attached-windows sheet)
(delete dialog (attached-windows sheet))))
(window-close dialog))
(defun cell-editor-cancel-fn (item)
(cell-editor-close (view-container item)))
(defun cell-editor-ok-fn (item)
(let ((window (view-container item)))
(let ((cell (editing-cell window))
(form
(parse-spreadsheet-formula
(dialog-item-text (view-named :formula window)))))
(setf (formula cell) form)
(recalculate (owner cell) (cell-x cell) (cell-y cell))
(cell-editor-close window))))
;;;
(defun make-check-dialog ()
(MAKE-INSTANCE 'DIALOG
:WINDOW-TYPE
:DOCUMENT
:VIEW-POSITION
#@(39 53)
:VIEW-SIZE
#@(471 239)
:VIEW-FONT
'("Chicago" 12 :SRCOR :PLAIN)
:VIEW-SUBVIEWS
(LIST (MAKE-DIALOG-ITEM
'SEQUENCE-DIALOG-ITEM
#@(0 -1)
#@(471 96)
"Untitled"
'NIL
:CELL-SIZE
#@(455 16)
:SELECTION-TYPE
:SINGLE
:TABLE-HSCROLLP
NIL
:TABLE-VSCROLLP
T
:TABLE-SEQUENCE
'(0 1 2))
(MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(280 109)
#@(50 14)
"101"
'NIL
:ALLOW-RETURNS
NIL)
(MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(148 110)
#@(67 13)
"1/1/93"
'NIL
:ALLOW-RETURNS
NIL)
(MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(71 143)
#@(252 14)
"Cash"
'NIL
:ALLOW-RETURNS
NIL)
(MAKE-DIALOG-ITEM
'STATIC-TEXT-DIALOG-ITEM
#@(11 138)
#@(56 22)
"Pay to the order of"
'NIL
:VIEW-FONT
'("Chicago" 9 :SRCOR :PLAIN))
(MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(362 142)
#@(71 14)
"99.00"
'NIL
:ALLOW-RETURNS
NIL)
(MAKE-DIALOG-ITEM 'STATIC-TEXT-DIALOG-ITEM #@(344 142) #@(11 16) "$"
'NIL)
(MAKE-DIALOG-ITEM
'STATIC-TEXT-DIALOG-ITEM
#@(70 168)
#@(260 16)
"Ninety nine and no/100"
'NIL)
(MAKE-DIALOG-ITEM
'EDITABLE-TEXT-DIALOG-ITEM
#@(72 196)
#@(253 14)
"Bucks"
'NIL
:ALLOW-RETURNS
NIL)
(MAKE-DIALOG-ITEM
'STATIC-TEXT-DIALOG-ITEM
#@(30 197)
#@(34 14)
"Memo"
'NIL
:VIEW-FONT
'("Chicago" 9 :SRCOR :PLAIN))
(MAKE-DIALOG-ITEM
'STATIC-TEXT-DIALOG-ITEM
#@(236 111)
#@(41 15)
"Number"
'NIL
:VIEW-FONT
'("Chicago" 9 :SRCOR :PLAIN)))))