stitchers.el/cell.el

;;; cell.el --- EIEIO spreadsheet mode -*- lexical-binding: nil; -*-

;; Copyright (C) 2006-2007, 2019 by David O'Toole

;; Author: David O'Toole <dto@xelf.me> <deeteeoh1138@gmail.com>
;; Maintainer: David O'Toole <dto@xelf.me> <deeteeoh1138@gmail.com>
;; URL: http://xelf.me/cell-mode.html
;; Package-Requires: ((emacs "24.4"))
;; License: GPLv3

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; (Version 3) as published by the Free Software Foundation. 

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program, in a text file called LICENSE. If not, see
;; <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Summary:

;; Cell-mode implements an abstract spreadsheet control in an Emacs
;; buffer.  The purpose of Cell-mode is to provide a major mode for
;; spreadsheet-based user interfaces; it can be further extended by
;; defining application-specific Emacs Lisp minor modes which supply
;; new cell and spreadsheet classes via Emacs' included object system,
;; EIEIO.  The website for Cell-mode is http://xelf.me/cell.html.

;; Features:

;; - Uses a simple file format based on Lisp property lists.  Cell-mode
;;   files can be visited, saved, loaded, and so on just like any other
;;   text file.  Works with Emacs' existing autosave, VC, and backup
;;   features.
;; - You can cut, copy, and paste cells between sheets using typical
;;   Emacs shortcuts, as well as insert and delete rows and
;;   columns.
;; - Undo/redo support.
;; - Execute sexps in cells, and other user defined actions.
;; - Rectangle selection via keyboard and mouse-drag are available.
;; - Object-orientation through the use of Emacs' included object
;;   system, EIEIO.  Cells can contain any Lisp value and respond
;;   polymorphically to events.
;; - Contents can be collected and processed however you want.
;; - Images, Unicode text, and variable-width fonts can be displayed
;; - in cells.

;; Issues:

;; - Columns are sometimes misaligned; restart Cell-mode with "M-x
;;   cell-mode RET" to restore proper formatting.
;; - Needs more optimization.

;; Notes:

;; - It is highly recommended to byte-compile this file so that
;;   commands execute quickly.
;; - Cell-mode source dates originally to 2006 and thus uses dynamic
;;   binding by default.  Two warnings each about free variables named
;;   "row" and "col" are to be expected during byte-compilation.

;; Getting started:

;; Download cell.el and place it in your Emacs load-path.  Then:

;;  (require 'cell)
;;  (add-to-list 'auto-mode-alist (cons "\\.cell" 'cell-mode))

;; Then use M-x CELL-SHEET-CREATE, or visit a new file with the
;; extension ".cell".  Press "Control-H m" to get help on the
;; keybindings.

;; To byte-compile and load cell-mode in one step, use:

;;   (byte-compile-file "/path/to/cell.el" t)

;; How to extend Cell-mode:

;; - Use EIEIO's DEFCLASS to derive new subclasses from the included
;;   CELL and CELL-SHEET classes in order to implement the new
;;   behaviors you want; use DEFINE-DERIVED-MODE or DEFINE-MINOR-MODE
;;   to extend the Emacs mode if necessary.  Available CELL methods
;;   are:

;;     (INITIALIZE-INSTANCE :AFTER (C CELL) &KEY)
;;       Define this :AFTER method for any initialization you need.

;;     (CELL-EXECUTE (C CELL))
;;       Perform a cell's action. S-Expression cells are evaluated.

;;     (CELL-COLLECT-VALUE-P (C CELL))
;;       Return non-nil if CELL-COLLECT-CELLS and related functions should
;;       include this cell in their output.

;;     (CELL-GET-VALUE (C CELL))
;;       Return the stored value.

;;     (CELL-SET-VALUE (C CELL) VALUE)
;;       Set the value.  You can define :BEFORE, :AFTER methods here
;;       etc.

;;     (CELL-FIND-VALUE (C CELL))
;;       Lazily find the value.  Just returns the value by default;
;;       subclasses can use this for cache-on-demand behavior.

;;     (CELL-TAP (C CELL))
;;       Primary (left-click) action for cells.  By default this just
;;       selects the cell.

;;     (CELL-ALTERNATE-TAP (C CELL))
;;       Secondary click action for cells.  By default this calls
;;       CELL-EXECUTE.

;;     (CELL-ACCEPT-STRING-VALUE (C CELL) STRING)
;;       Accept a string representing the value, instead of the value.
;;       Normally you will not have to modify this.

;;  Other functions include:

;;      (CELL-SHEET-CREATE &OPTIONAL ROWS COLS CLASS)
;;        Create a new cell sheet in a new buffer with ROWS rows and
;;        COLS columns. Optionally use CLASS instead of the default
;;        cell sheet class.

;;      (CELL-COLLECT-CELLS SHEET)
;;        Return a flat list of all cells in the spreadsheet, in
;;        left-to-right then top-to-bottom order.

;;      (CELL-COLLECT-CELLS-BY-ROW SHEET)
;;        Return a list of rows of cells from the spreadsheet.

;;   The buffer-local variable CELL-CURRENT-SHEET is always set to the
;;   current CELL-CURRENT-SHEET object in Cell-mode buffers.

;;   Documentation for the CELL-SHEET class is forthcoming.  Read on
;;   and check the docstrings below if you wish to learn more.

;;; Code:

(require 'cl)
(require 'eieio)
(require 'eieio-base)
(require 'eieio-custom)
(require 'eieio-speedbar)

;;; Memoization facility.

;; The `defun-memo' facility is based on code by Peter Norvig
;; for his book "Paradigms of Artificial Intelligence
;; Programming". The modified versions are redistributed here under
;; the terms of the General Public License as given above.

;; You can find more information on Norvig's book at his website:
;; http://www.norvig.com/paip.html
;; http://www.norvig.com/license.html

(cl-defmacro defun-memo (name args memo-args &body body)
  "Define a memoized function named NAME.
ARGS is the lambda list giving the memoized function's arguments.
MEMO-ARGS is a list with optional keyword arguments for the
memoization process: :KEY, :VALIDATOR, and :TEST."
  `(memoize (cl-defun ,name ,args . ,body) ,@memo-args))

(cl-defun memo (fn &key (key #'first) (test #'eql) validator name)
  "Return a memo-function of fn."
  (let ((table (make-hash-table :test test)))
    (setf (get name 'memo) table)
    (lexical-let ((key* key)
                  (table* table)
                  (validator* validator)
                  (fn* fn))
      #'(lambda (&rest args)
          (let ((k (funcall key* args)))
            (let* ((val (gethash k table* :default-|-value))
                   (found-p (not (eq val :default-|-value))))
              (if found-p 
                  val
		;; only cache if value is valid
		(let ((candidate-value (apply fn* args)))
		  (prog1 candidate-value
		    (when (or (null validator*)
			      (funcall validator* candidate-value))
		      (setf (gethash k table*) candidate-value)))))))))))

(cl-defun memoize (fn-name &key (key #'first) (test #'eql) validator)
  "Replace fn-name's global definition with a memoized version."
  (clear-memoize fn-name)
  (setf (symbol-function fn-name)
        (memo (symbol-function fn-name)
              :name fn-name :key key :test test :validator validator)))

(cl-defun clear-memoize (fn-name)
  "Clear the hash table from a memo function."
  (let ((table (get fn-name 'memo)))
    (when table (clrhash table))))

(cl-defun get-memo-table (fn-name)
  (get fn-name 'memo))

;;; EIEIO compatibility macros

;; The following compatibility macros transform code using the old
;; DEFSTRUCT-style class definitions and slot accessors (which is
;; still perfectly readable and useful) into the modern way of doing
;; object orientation in Emacs, namely EIEIO. This is transparent to
;; the cell and sheet subclasses you define, which can just use the
;; normal EIEIO slot accessors.

;; Also, for compatibility with the original code, this file does not
;; use Emacs Lisp LEXICAL-BINDING (see local variable on first line.)

(cl-defmacro cell-defslot (class slot)
  (let ((instance (cl-gensym))
        (value (cl-gensym))
        (getter (intern (concat (symbol-name class) "-" (symbol-name slot))))
        (setter (intern (concat "cell-set-value/"
                                (symbol-name class) "-" (symbol-name slot)))))
    `(progn
       (defun ,getter (,instance)
         (slot-value ,instance ',slot))
       (defun ,setter (,instance ,value)
         (setf (slot-value ,instance ',slot)
               ,value))
       (defsetf ,getter ,setter))))

(cl-defmacro cell-defclass (name superclasses &rest specs)
  `(defclass ,name ,superclasses
     ,(mapcar #'(lambda (spec)
                  (if (listp spec)
                      spec
                    (list
                     spec
                     :initform nil
                     :initarg (intern (concat ":" (symbol-name spec))))))
              specs)))

;;; Customization

(defcustom cell-cursor-blink-interval 0.5
  "How many seconds to wait between cursor blinks."
  :tag "Cursor blink interval"
  :group 'cell
  :type 'number)

(defcustom cell-cursor-blink-p t
  "When non-nil, blink active cursor."
  :group 'cell
  :type 'boolean)

(defcustom cell-blank-width 4 "Default width of blank cells, in spaces."
  :group 'cell
  :type 'integer)

(defcustom cell-no-label-string "no label"
  "Default string for when a cell has no label."
  :group 'cell
  :type 'string)

;;; Utilities

(defun cell-char-width-pixels (char)
  (with-temp-buffer
    (set-window-buffer (selected-window) (current-buffer))
    (insert-char char)
    (aref (aref (font-get-glyphs (font-at 1) 1 2) 0) 4)))

(defun cell-string-width (str)
  (/ (float (apply #'+ (map 'list #'cell-char-width-pixels str)))
     (float (window-font-width))))

;;; Variables

(defvar cell-timer nil "Timer object for periodic updates.")

(defvar cell-current-sheet nil "This buffer's cell-sheet object.")
(make-variable-buffer-local 'cell-sheet)

(defvar cell-clipboard nil "List of cell rows on the clipboard.")

(defvar cell-cached-buffer-positions nil)
(make-variable-buffer-local 'cell-cached-buffer-positions)

(cell-defclass cell ()
               label       ; label to be displayed on the cell
               label-width ; width of label (when not integral; used for images)
               value       ; can be any lisp object the cell requires.
               face        ; face to display cell label with,
                                        ; or use propertized text for label)
               )

(cell-defslot cell label)
(cell-defslot cell label-width)
(cell-defslot cell value)
(cell-defslot cell face)

(cl-defmethod initialize-instance :after ((c cell) &rest slots)
  "Initialize the cell C."
  nil)

(cl-defmethod cell-execute ((c cell))
  "Perform action when cell is executed."
  nil)

(cl-defmethod cell-collect-value-p ((c cell))
  "When non-nil, collect the value of this cell during
CELL-COLLECT-CELLS and related calls."
  t)

(cl-defmethod cell-get-value ((c cell))
  "Return the value of the cell C."
  (slot-value c 'value))

(cl-defmethod cell-set-value ((c cell) value)
  "Set the value of cell C to VALUE."
  (setf (slot-value c 'value) value))

(cl-defmethod cell-find-value ((c cell))
  "Lazily find the value. Subclasses can use this for caching."
  (cell-get-value c))

(cl-defmethod cell-accept-string-value ((c cell) string)
  "Accept a string instead of a value."
  (cell-set-value c string))

(cl-defmethod cell-tap ((c cell))
  "Primary click action for cell C." nil)

(cl-defmethod cell-alternate-tap ((c cell))
  "Secondary click action for cell C. By default this executes the
cell."
  (cell-execute c))

(cl-defmethod cell-contains-image-p ((c cell)) nil)

;;; Blinking the cursor and other periodic updates

(defun cell-update-cursor-blink ()
  (when (and cell-cursor-blink-p
             (eq major-mode 'cell-mode)
             (eq (current-buffer) (window-buffer)))
    (cell-sheet-display-cursors (overlays-in (point-min) (point-max)))))

(defun cell-start-timer ()
  (when (timerp cell-timer)
    (cancel-timer cell-timer))
  (setf cell-timer (run-with-timer
                    0 cell-cursor-blink-interval
                    'cell-update-cursor-blink)))

(defun cell-stop-timer ()
  (when (timerp cell-timer)
    (cancel-timer cell-timer)))

(cl-defmethod cell-fill-space ((cell cell) face) nil)

;;; Lisp expression cells

(cell-defclass cell-expression (cell))

(cl-defmethod cell-set-value :after ((c cell-expression) value)
  (setf (cell-label-width c)
        (cell-string-width value))
  (setf (cell-label c) value))

(cl-defmethod cell-find-value ((exp cell-expression))
  (when (stringp (cell-value exp))
    (car (read-from-string (cell-value exp)))))
  
(cl-defmethod cell-execute ((exp cell-expression))
  (eval (cell-find-value exp)))

(cl-defmethod cell-fill-space ((exp cell-expression) face)
  (let ((width (cell-label-width exp)))
    (when width
      (cell-insert-spacer (ceiling width) face))))

;;; Comment cells

(cell-defclass cell-comment-cell (cell-expression))

(cl-defmethod cell-collect-value-p ((c cell-comment-cell)) nil)

(cl-defmethod cell-set-value :after ((c cell-comment-cell) value)
  (setf (cell-face c) 'cell-comment-2-face))

;;; Image cells

(cell-defclass cell-image-cell (cell) image)
(cell-defslot cell image)

(cl-defmethod cell-set-value :after ((i cell-image-cell) image-name)
  (setf (cell-image i)
        (create-image (car (read-from-string image-name))))
  (setf (cell-label-width i)
        (car (image-size (cell-image i))))
  (setf (cell-label i)
        (propertize "  " 'display (cell-image i))))

(cl-defmethod cell-contains-image-p ((c cell-image-cell)) t)

;;; Internal grid data structure

(defun cell-make-grid (rows cols)
  "Make a new grid with ROWS rows and COLS columns."
  (let ((grid (make-vector rows nil)))
    (dotimes (row rows)
      (setf (aref grid row) (make-vector cols nil))) 
    grid))

(defun cell-grid-get (grid row col)
  "Return the object in GRID at row ROW and column COL."
  (when (and (< row (length grid))
             (< col (length (aref grid 0))))
    (aref (aref grid row) col)))

(defun cell-grid-set (grid row col value)
  "Set the object at GRID location ROW,COL to VALUE."
  (when (and (< row (length grid))
             (< col (length (aref grid 0))))
    (let ((row (aref grid row)))
      (setf (aref row col) value))))

(defun cell-grid-columns (grid)
  "Return the number of columns in the GRID."
  (length (aref grid 0)))

(defun cell-grid-rows (grid)
  "Return the number of rows in the GRID."
  (length grid))

(defun cell-vector-insert (oldvec pos elt)
  "Insert into OLDVEC at position POS the element ELT."
  (let* ((len (length oldvec))
         (newvec (make-vector (+ len 1) nil)))
    (dotimes (i (+ 1 len))
      (setf (aref newvec i) (cond 
                             (( < i pos)
                              (aref oldvec i))
                             (( equal i pos)
                              elt)
                             (( > i pos) 
                              (aref oldvec (- i 1))))))
    newvec))

(defun cell-vector-delete (oldvec pos)
  "Remove from vector OLDVEC the position POS."
  (let* ((len (length oldvec))
         (newvec (make-vector (- len 1) nil)))
    (dotimes (i (- len 1))
      (setf (aref newvec i) (cond
                             (( < i pos)
                              (aref oldvec i))
                             (( >= i pos)
                              (aref oldvec (+ i 1))))))
    newvec))

(defun cell-grid-insert-row (grid row)
  "Return a copy of GRID with a row inserted at row ROW."
  (let* ((newrow (make-vector (cell-grid-columns grid) nil)))
    (cell-vector-insert grid row newrow)))

(defun cell-grid-insert-column (grid col)
  "Return a copy of GRID with a column inserted at column COL."
  (dotimes (i (cell-grid-rows grid))
    (setf (aref grid i) (cell-vector-insert (aref grid i) col nil)))
  grid)

(defun cell-grid-delete-row (grid row)
  "Return a copy of GRID with the row ROW removed."
  (cell-vector-delete grid row))

(defun cell-grid-delete-column (grid col)
  "Return a copy of GRID with the column COL removed."
  (dotimes (i (cell-grid-rows grid))
    (setf (aref grid i) (cell-vector-delete (aref grid i) col)))
  grid)

;;; Sheets

(cell-defclass cell-sheet ()
               name ; string title, currently ignored
               rows ; initial requested number of rows
               cols ; initial requested number of columns
               mark ; nil when there is no mark, or (LIST ROW COL) 
               rendering ; cached buffer text of spreadsheet
               widths ; column widths
               row-header-width ; width of leftmost column 
               buffer ; what buffer is this sheet in?
               cursor ; what cell is the user pointing at? (LIST ROW COL)
               selection ; rectangle in this form: (row-1 col-1 row-2 col-2)
               grid ; two-dimensional array of spreadsheet cells
               column-stops ; vector of integers where v[x] is first column number of column x
               buffer ; associated buffer where user interface is displayed
               borders-p ; whether to display borders
               headers-p ; whether to display headers
               raw-display-p ; whether we are doing raw display
               properties) ; general-purpose plist for extensions

(cell-defslot cell-sheet name)
(cell-defslot cell-sheet rendering)
(cell-defslot cell-sheet mark)
(cell-defslot cell-sheet widths)
(cell-defslot cell-sheet row-header-width)
(cell-defslot cell-sheet rows)
(cell-defslot cell-sheet cols)
(cell-defslot cell-sheet buffer)
(cell-defslot cell-sheet cursor)
(cell-defslot cell-sheet selection)
(cell-defslot cell-sheet grid)
(cell-defslot cell-sheet column-stops)
(cell-defslot cell-sheet borders-p)
(cell-defslot cell-sheet headers-p)
(cell-defslot cell-sheet raw-display-p)
(cell-defslot cell-sheet properties)

(defmacro cell-with-current-cell-sheet (&rest body)
  "Evaluate BODY forms with cell-sheet variables bound."
  (declare (debug t))
  `(let* ((inhibit-read-only t)
          (rendering (cell-sheet-rendering cell-current-sheet))
          (grid (cell-sheet-grid cell-current-sheet))
          (cursor (cell-sheet-cursor cell-current-sheet))
          (cursor-row (cl-first cursor))
          (cursor-column (cl-second cursor))
          (selection (cell-sheet-selection cell-current-sheet))
          (cell^ (cell-grid-get grid cursor-row cursor-column))
          (stops (cell-sheet-column-stops cell-current-sheet)))
     ,@body))

;;; Undo/redo support

(defvar cell-undo-history nil "Undo history for current cell sheet.")
(make-variable-buffer-local 'cell-undo-history)

(defvar cell-redo-history nil "Redo history for current cell sheet.")
(make-variable-buffer-local 'cell-redo-history)

(defun cell-push-undo-history ()
  "Push a serialized copy of the cell sheet onto the undo history."
  (push (cell-sheet-serialize cell-current-sheet)
        cell-undo-history))

(defun cell-push-redo-history ()
  "Push a serialized copy of the cell sheet onto the redo history."
  (push (cell-sheet-serialize cell-current-sheet)
        cell-redo-history))

(defun cell-pop-undo-history ()
  "Undo the last action."
  (let ((inhibit-read-only t)
        (cursor (cell-sheet-cursor cell-current-sheet))
        (class (or (cell-sheet-setting-value cell-current-sheet 'cell-sheet-class)
                   'cell-sheet)))
    (if (null cell-undo-history)
        (progn (beep) (message "Cell-mode: undo history is empty."))
      (progn 
        (setf cell-current-sheet
              (cell-sheet-from-plist (cdr (car (read-from-string (pop cell-undo-history))))
                                     class
                                     ))
        (cell-sheet-update)
        (setf (cell-sheet-cursor cell-current-sheet) cursor)
        (cell-sheet-after-open-hook cell-current-sheet)
        (setf (buffer-modified-p (current-buffer)) t)
        (message "Undo! %d change(s) remaining." (length cell-undo-history))))))

(defun cell-sheet-undo ()
  "Undo the last edit."
  (interactive)
  (cell-with-current-cell-sheet
   (let ((inhibit-read-only t))
     (cell-push-redo-history)
     (cell-pop-undo-history)
     (cell-sheet-update))))

(defun cell-sheet-redo ()
  "Redo the last undo operation."
  (interactive)
  (let ((inhibit-read-only t)
        (cursor (cell-sheet-cursor cell-current-sheet)))
    (if (null cell-redo-history)
        (progn (beep) (message "Cell-mode: redo history is empty."))
      (progn
        (push (pop cell-redo-history)
              cell-undo-history)
        (cell-pop-undo-history)
        (setf (cell-sheet-cursor cell-current-sheet) cursor)
        (cell-sheet-update)
        (message "Redo! %d redo(s) remaining." (length cell-redo-history))))))

;;; Major mode declaration

(defvar cell-mode-map nil "Keymap for Cell-mode.")

(defun cell-find-cell-mode-map ()
  "Return the cell-mode keymap."
  (or cell-mode-map
      (setf cell-mode-map
            (make-sparse-keymap))))

(defun cell-mode-insinuate ()
  "Install local keybindings for Cell-mode."
  (interactive)
  (mapcar (lambda (mapping)
            (define-key (cell-find-cell-mode-map) (car mapping) (cdr mapping)))
          `(([(control c)(control e)] . cell-sheet-execute)
            ([(return)] . cell-sheet-create-cell)
            ([(next)] . cell-sheet-page-down)
            ([(prior)] . cell-sheet-page-up)
            ([(control ? )] . cell-sheet-set-mark)
            ([(escape)] . cell-sheet-clear-mark)
            ([(shift return)] . cell-sheet-execute)
            ([(control c)(control c)] . cell-sheet-create-comment)
            ([(control c) ?i] . cell-sheet-create-image)
            ([(control d)] . cell-sheet-delete-cell)
            ([(control z)] . cell-sheet-undo)
            ([(control /)] . cell-sheet-undo)
            ([(control shift z)] . cell-sheet-redo)
            ([(control ??)] . cell-sheet-redo)
            (,(kbd ":") . cell-sheet-create-comment)
            (,(kbd ";") . cell-sheet-create-comment)
            ;; navigating to corners
            ([(meta ?<)] . cell-sheet-move-bob)
            ([(meta ?>)] . cell-sheet-move-eob)
            ;; adding and removing rows
            (,(kbd "\C-c\C-n\C-r") . cell-sheet-insert-row)
            (,(kbd "\C-c\C-n\C-c") . cell-sheet-insert-column)
            (,(kbd "\C-c\C-d\C-r") . cell-sheet-delete-row)
            (,(kbd "\C-c\C-d\C-c") . cell-sheet-delete-column)
            ;; arrow keys
            ([(up)] . cell-sheet-move-cursor-up)
            ([(down)] . cell-sheet-move-cursor-down)
            ([(left)] . cell-sheet-move-cursor-left)
            ([(right)] . cell-sheet-move-cursor-right)
            ;; traditional cursor-motion keys
            ([(control a)] . cell-sheet-move-bol)
            ([(control e)] . cell-sheet-move-eol)
            ([(home)] . cell-sheet-move-bol)
            ([(end)] . cell-sheet-move-eol)
            ([(control f)] . cell-sheet-move-cursor-right)
            ([(control b)] . cell-sheet-move-cursor-left)
            ([(control n)] . cell-sheet-move-cursor-down)
            ([(control p)] . cell-sheet-move-cursor-up)
            ;; the mouse
            ([(mouse-1)] . cell-sheet-mouse-move-cursor)          
            ([(mouse-3)] . mouse-major-mode-menu)
            ([(mouse-5)] . cell-sheet-page-down)
            ([(mouse-4)] . cell-sheet-page-up)
            ([(drag-mouse-1)] . cell-sheet-mouse-select)        
            ;; cut and paste
            ([(meta w)] . cell-sheet-copy-to-clipboard)
            ([(control w)] . cell-sheet-cut-to-clipboard)
            ([(control y)] . cell-sheet-paste))))

(cell-mode-insinuate)

(define-derived-mode cell-mode nil "Cell"
  "Abstract spreadsheet display mode."
  (let ((inhibit-read-only t))
    (make-local-variable 'cell-sheet)
    (make-local-variable 'tool-bar-map)
    (setf tool-bar-map (cell-enable-tool-bar-map))
    (if (zerop (length (buffer-substring-no-properties (point-min) (point-max))))
        ;; new blank sheet
        (setf cell-current-sheet
              (make-instance 'cell-sheet :name (buffer-file-name (current-buffer))))
      ;; recover serialized sheet
      (setf cell-current-sheet
            (cell-sheet-from-plist
             (cdr (car (read-from-string
                        (buffer-substring-no-properties
                         (point-min) (point-max))))))))
    ;; finish initializing cell mode in new buffer
    (setf cell-cached-buffer-positions (make-hash-table :test 'equal))
    (delete-region (point-min) (point-max))
    (add-hook 'before-save-hook 'cell-remove-rendering)
    (add-hook 'after-save-hook 'cell-sheet-update*)
    (cell-mode-insinuate)
    (cell-sheet-update)
    (cell-sheet-after-open-hook cell-current-sheet)
    (setf (buffer-modified-p (current-buffer)) nil)))

;;; Initializing sheets

(cl-defmethod initialize-instance :after ((sheet^ cell-sheet) &rest slots)
  "Initialize SHEET and its buffer for Cell-mode."
  (setf cell-current-sheet sheet^)
  (let* ((new-buffer (current-buffer))
         (inhibit-read-only t)
         (rows (or (slot-value sheet^ 'rows) 15))
         (cols (or (slot-value sheet^ 'cols) 10)))
    (with-slots (buffer grid cursor column-stops
                        borders-p headers-p)
        cell-current-sheet
      (setf buffer new-buffer)
      (setf grid (or grid (cell-make-grid rows cols)))
      (setf column-stops (make-vector (+ cols 1) 0))
      (setf cursor '(0 0))
      (setf borders-p t)
      (setf headers-p t)
      ;; set up the buffer to act the right way
      (with-current-buffer buffer
        (setf cursor-type nil)
        ;; next line changed from (toggle-truncate-lines 1) for
        ;; emacs-21 compatibility.
        (setf truncate-lines t)
        (buffer-disable-undo buffer)
        (make-local-variable 'cell-current-sheet)
        (setf buffer-read-only t)
        (cell-mode-insinuate)
        (cell-sheet-after-open-hook sheet^)
        (setf (buffer-modified-p buffer) nil))
      sheet^)))

;;; The mark and the selection

(defun cell-sheet-set-mark ()
  "Begin defining a region by putting the mark here."
  (interactive)
  (cell-with-current-cell-sheet
   (setf (cell-sheet-mark cell-current-sheet) (list cursor-row cursor-column))
   (cell-sheet-update-selection-from-mark)
   (cell-sheet-update)))

(defun cell-sheet-update-selection-from-mark ()
  "Update the selection based on mark and cursor."
  (cell-with-current-cell-sheet
   (let ((mark (cell-sheet-mark cell-current-sheet)))
     (when mark
       (when (not (and  (= (car mark) cursor-row)
                        (= (cadr mark) cursor-column)))
         (setf (cell-sheet-selection cell-current-sheet)
               (list cursor-row cursor-column
                     (car mark) (cadr mark))))))))

(defun cell-sheet-clear-mark* ()
  "Clear the mark and selection without updating the sheet."
  (cell-with-current-cell-sheet
   (setf (cell-sheet-mark cell-current-sheet) nil)
   (setf (cell-sheet-selection cell-current-sheet) nil)))

(defun cell-sheet-clear-mark ()
  "Stop defining a region by clearing the mark."
  (interactive)
  (cell-sheet-clear-mark*)
  (cell-sheet-update))

;;; Cut, copy, paste

(defun cell-copy-cell (c)
  (when c
    (let ((class (eieio-object-class c)))
      (with-slots (label value face) c
        (let ((label* (copy-tree label :vec))
              (value* (copy-tree value :vec))
              (face* (copy-tree face :vec)))
          (make-instance class :label label* :value value* :face face*))))))

(defun cell-sheet-copy-to-clipboard ()
  "Copy the currently selected region to the clipboard."
  (interactive)
  (cell-with-current-cell-sheet
   (if (null selection)
       (progn (setf cell-clipboard (list (list (cell-copy-cell (cell-grid-get grid cursor-row cursor-column)))))
              (message "The cell at the cursor was copied to the clipboard."))
     (let* ((inhibit-read-only t))
       (cl-destructuring-bind (r1 c1 r2 c2) selection
         (let* ((dr (abs (- r2 r1)))
                (dc (abs (- c2 c1)))
                (start-row (min r1 r2))
                (start-col (min c1 c2))
                (out-rows ())
                (out-column ()))
           (cl-do ((r start-row (+ 1 r)))
               ((> r (+ dr start-row)))
             (cl-do ((c start-col (+ 1 c)))
                 ((> c (+ dc start-col)))
               (push (cell-copy-cell (cell-grid-get grid r c))
                     out-column))
             (push (reverse out-column) out-rows)
             (setf out-column nil))
           (setf cell-clipboard (reverse out-rows))))
       (cell-sheet-clear-mark*)
       (cell-sheet-update)
       (message "The selection was copied to the clipboard.")))))

(defun cell-sheet-blank-selection (&optional sel)
  "Remove all cells within the current selection."
  (interactive)
  (cell-with-current-cell-sheet
   (when (or sel selection)
     (let* ((inhibit-read-only t))
       (cell-push-undo-history)
       (cl-destructuring-bind (r1 c1 r2 c2) (or sel (slot-value cell-current-sheet 'selection))
         (let* ((dr (abs (- r2 r1)))
                (dc (abs (- c2 c1)))
                (start-row (min r1 r2))
                (start-col (min c1 c2))
                (out-rows ())
                (out-column ()))
           (cl-do ((r start-row (+ 1 r)))
               ((> r (+ dr start-row)))
             (cl-do ((c start-col (+ 1 c)))
                 ((> c (+ dc start-col)))
               (cell-grid-set grid r c nil)))))))))

(defun cell-sheet-cut-to-clipboard ()
  "Cut the selected cells to the clipboard."
  (interactive)
  (cell-with-current-cell-sheet
   (cell-push-undo-history)
   (if (null (cell-sheet-selection cell-current-sheet))
       (cell-grid-set grid cursor-row cursor-column nil)
     (progn
       (let ((sel (cell-sheet-selection cell-current-sheet)))
         (cell-sheet-copy-to-clipboard)
         (cell-sheet-blank-selection sel))))
   (cell-sheet-clear-mark*)
   (cell-sheet-update)
   (message "The selection was cut to the clipboard.")))

(defun cell-sheet-paste ()
  "Paste the current contents of the clipboard at the cursor."
  (interactive)
  (let ((inhibit-read-only t))
    (cell-push-undo-history)
    (cell-with-current-cell-sheet
     (let ((rows cell-clipboard))
       (cl-do ((r cursor-row (1+ r)))
           ((null rows))
         (let ((col (pop rows)))
           (cl-do ((c cursor-column (1+ c)))
               ((null col))
             (cell-grid-set grid r c (cell-copy-cell (pop col)))))))
     (cell-sheet-clear-mark*)
     (cell-sheet-update))))

;;; Blanking a cell sheet

(cl-defmethod cell-sheet-blank ((sheet^ cell-sheet) rows cols)
  ;; don't use this function interactively; it doesn't save undo history!
  (let ((inhibit-read-only t))
    (setf (cell-sheet-grid sheet^) 
          (cell-make-grid rows cols))
    (setf (cell-sheet-cursor sheet^) (list 0 0))))

;;; The cursor and the selection

(defun cell-move-point-to-rendering ()
  "Move point to the place where the sheet will be rendered."
  (goto-char (point-min))
  (while (and (not (eobp))
              (not (get-text-property (point) 'rendering)))
    (forward-char 1))
  (when (not (get-text-property (point) 'rendering))
    (error "Cell-mode: could not find rendering text property"))
  (forward-char 1)
  (point))

(defun cell-sheet-display-cursor (row column &optional face)
  "Display a cursor using overlays at the give ROW and COLUMN.
The argument FACE specifies the face to use for the overlay."
  (cell-with-current-cell-sheet
   (let* ((inhibit-read-only t)  
          (face (or face 'cell-cursor-face))
          (cursor-width (if (and cell^ (cell-label-width cell^))
                            (ceiling (cell-label-width cell^))
                          (- (aref stops (+ column 1)) 
                             (aref stops column)))))
     (let ((p (gethash (list row column) cell-cached-buffer-positions)))
       (let ((cl (cell-grid-get grid row column))
             (p0 0))
         (when cl
           (when (cell-label-width cl)
             (setf cursor-width (ceiling (max cell-blank-width (cell-label-width cl))))))
         (let ((ov (make-overlay (+ p0 (- p cursor-width)) p)))
           (overlay-put ov 'face face)
           (goto-char p)))))))

(defun cell-sheet-highlight-cell (row column &optional face)
  "Highlight a cell by adding face properties at ROW and COLUMN.
The argument FACE specifies which face to use."
  (cell-with-current-cell-sheet
   (let* ((inhibit-read-only t)  
          (cursor-width (if (and cell^ (cell-label-width cell^))
                            (ceiling (cell-label-width cell^))
                          (- (aref stops (+ column 1)) 
                             (aref stops column))))
          (face (or face 'cell-cursor-face)))
     (cell-move-point-to-rendering)
     ;; move to right place
     (forward-line (+ 1 row))
     (forward-char (aref stops column))
     ;; adjust cursor when images are present in any cells to left
     (let ((n 0))
       (dotimes (c column)
         (let ((cl (cell-grid-get grid row c)))
           (when cl
             (when (cell-label-width cl)
               (cl-incf n)
               (backward-char 1)))))
       ;; (when (plusp n)
       ;;        (goto-char (+ (point-at-bol) (aref stops column)))
       ;;        (forward-char (+ n 1))))
       (add-text-properties (point) (+ (point) cursor-width)
                            (list 'face face))))))

(defun cell-sheet-display-selection ()
  "Display the selection using text properties."
  (cell-with-current-cell-sheet
   (when selection
     (let* ((inhibit-read-only t))
       (cl-destructuring-bind (r1 c1 r2 c2) selection
         (let* ((dr (abs (- r2 r1)))
                (dc (abs (- c2 c1)))
                (start-row (min r1 r2))
                (start-col (min c1 c2))
                (current-cell nil))
           (goto-char (point-min))
           (forward-line (1+ start-row))
           (cl-do ((r start-row (+ r 1)))
               ((> r (+ start-row dr)))
             (beginning-of-line)
             (let* ((pos (+ (point-at-bol) (aref stops start-col)))
                    (end pos))
               (cl-do ((c start-col (+ c 1)))
                   ((> c (+ start-col dc)))
                 (setf current-cell (cell-grid-get grid r c))
                 (let ((cursor-width (if (and current-cell (cell-label-width current-cell))
                                         (ceiling (cell-label-width current-cell))
                                       (- (aref stops (+ c 1)) 
                                          (aref stops c)))))
                   (cl-incf end cursor-width)))
               (add-text-properties pos end
                                    (list 'face 'cell-selection-face)))
             (forward-line))))))))

(defun cell-sheet-in-selection (rxx cxx)
  "Return non-nil if row RXX, column CXX is within the selection."
  (let ((selection (cell-sheet-selection cell-current-sheet)))
    (when selection
      (let ((r1 (pop selection))
            (c1 (pop selection))
            (r2 (pop selection))
            (c2 (pop selection)))
        (and (<= (min r1 r2) rxx (max r1 r2))
             (<= (min c1 c2) cxx (max c1 c2)))))))

(defun cell-sheet-display-cursors (&optional just-delete)
  "Display all the cursors."
  (cell-with-current-cell-sheet
   ;; remove overlays. there is a fix for emacs-21 here, which does
   ;; not have the function (remove-overlays)
   (if (fboundp 'remove-overlays)
       (remove-overlays)
     (mapc #'delete-overlay (overlays-in (point-min) (point-max))))
   ;; The commented out code below is sometimes used during testing.
   ;;
   ;; (when selection
   ;;   (cell-sheet-display-selection))
   (unless just-delete
     (let ((c (cell-grid-get grid cursor-row cursor-column)))
       (if c
           ;;(if (null (cell-label-width c))
               (cell-sheet-display-cursor cursor-row cursor-column)
             ;;(cell-sheet-highlight-cell cursor-row cursor-column 'cell-cursor-face)
           )
         (cell-sheet-display-cursor cursor-row cursor-column)))))
  ;;(cell-sheet-highlight-cell cursor-row cursor-column 'cell-cursor-face)
;; (let ((m (cell-sheet-mark sheet)))
;;   (when m (cell-sheet-display-cursor (first m) (second m) 'cell-mark-face)))))

(defun cell-sheet-move-bol ()
  "Move to the beginning of the line."
  (interactive)
  (cell-with-current-cell-sheet
   (with-slots (cursor) cell-current-sheet
     (setf cursor
           (list (cl-first cursor) 0)))
   (cell-sheet-update)))

(defun cell-sheet-move-eol ()
  "Move to the end of the line." 
  (interactive)
  (cell-with-current-cell-sheet
   (with-slots (cursor grid) cell-current-sheet
     (setf cursor
           (list (cl-first cursor)
                 (1- (length (aref grid 0))))))
   (cell-sheet-update)))

(defun cell-sheet-move-bob ()
  "Move to the top left corner of the cell sheet."
  (interactive)
  (cell-with-current-cell-sheet
   (with-slots (cursor) cell-current-sheet
     (setf cursor (list 0 0))
     (cell-sheet-update))))

(defun cell-sheet-move-eob ()
  "Move to the bottom right corner of the cell sheet."
  (interactive)
  (cell-with-current-cell-sheet
   (with-slots (cursor grid) cell-current-sheet
     (setf cursor
           (list (1- (length grid))
                 (1- (length (aref grid 0))))))
   (cell-sheet-update)))

(cl-defun cell-sheet-move-cursor (direction &optional (distance 1))
  "Move the cursor one cell in DIRECTION."
  (cell-with-current-cell-sheet
   ;; clear selection
   (setf (cell-sheet-selection cell-current-sheet) nil)
   ;; calculate new cursor location
   (let* ((rows (cell-grid-rows grid))
          (cols (cell-grid-columns grid))
          (new-cursor
           (cl-case direction
             (:up (if (not (minusp (- cursor-row distance)))
                      (list (- cursor-row distance) cursor-column)
                    cursor))
             (:left (if (not (minusp (- cursor-column distance)))
                        (list cursor-row (- cursor-column distance))
                      cursor))
             (:down (if (< cursor-row (- rows distance))
                        (list (+ cursor-row distance) cursor-column)
                      cursor))
             (:right (if (< cursor-column (- cols distance))
                         (list cursor-row (+ cursor-column distance))
                       cursor)))))
     (setf (cell-sheet-cursor cell-current-sheet) new-cursor)
     ;; choose technique for display
     (if (cell-sheet-raw-display-p cell-current-sheet)
         ;; just move point to where cursor should go
         (progn
           (let ((buffer-position (+ 1 (cl-second new-cursor)
                                     (* (cl-first new-cursor)
                                        (+ 1 (cell-grid-columns grid))))))
             (goto-char buffer-position)
             ))
       ;; display cell-mode cursor with overlay
       (if (cell-sheet-mark cell-current-sheet)
           (progn (cell-remove-rendering*)
                  (cell-sheet-update-selection-from-mark)
                  (cell-sheet-update :lazy)
                  (cell-sheet-display-cursors))
         (progn
           (cell-sheet-display-cursors)))))))
;; (cell-remove-rendering)
;; (cell-sheet-update :lazy)))))))

(defun cell-sheet-move-cursor-up ()
  "Move the cursor one cell upward."
  (interactive)
  (cell-sheet-move-cursor :up))

(defun cell-sheet-move-cursor-left ()
  "Move the cursor one cell leftward."
  (interactive)
  (cell-sheet-move-cursor :left))

(defun cell-sheet-move-cursor-down ()
  "Move the cursor one cell downward."
  (interactive)
  (cell-sheet-move-cursor :down))

(defun cell-sheet-move-cursor-right ()
  "Move the cursor one cell rightward."
  (interactive)
  (cell-sheet-move-cursor :right))

(defun cell-sheet-page-up ()
  (interactive)
  ;; check for correct major mode, in case mouse is over a cell-mode
  ;; buffer that isn't the current buffer.
  (when (eq major-mode 'cell-mode)
    (cell-sheet-move-cursor :up 10)))

(defun cell-sheet-page-down ()
  (interactive)
  (when (eq major-mode 'cell-mode)
    (cell-sheet-move-cursor :down 10)))

;;; Executing cells

(defun cell-sheet-execute ()
  "Execute the current cell."
  (interactive)
  (cell-with-current-cell-sheet (cell-execute cell^)))

;;; Deleting cells

(defun cell-sheet-delete-cell ()
  "Delete the current cell."
  (interactive)
  (cell-with-current-cell-sheet
   (cell-push-undo-history)
   (cell-grid-set grid cursor-row cursor-column nil)
   (cell-sheet-update)))

;;; Interactively creating and editing cells

(cl-defmethod cell-sheet-after-update-hook ((sheet cell-sheet))
  nil)

(cl-defmethod cell-sheet-after-open-hook ((sheet cell-sheet))
  (setf (buffer-modified-p (current-buffer)) nil))

(defun cell-sheet-create-cell (&optional no-change)
  "Create or edit a cell at the cursor."
  (interactive)
  (cell-with-current-cell-sheet
   (cell-push-undo-history)
   (let* ((the-cell (cell-grid-get grid cursor-row cursor-column))
          (value (when the-cell (cell-value the-cell))))
     (let* ((instance (or the-cell (make-instance 'cell-expression)))
            (default (cell-value instance))
            (val (if no-change default (read-from-minibuffer "Enter value: "
                                                             (when the-cell default)))))
       (when (and (stringp val)
                  (> (length val) 0))
         (cell-grid-set grid cursor-row cursor-column (copy-tree instance :copy-vectors))
         (cell-accept-string-value instance (copy-tree val :copy-vectors)))))
   (cell-sheet-after-update-hook cell-current-sheet)
   (cell-sheet-update)))

(defun cell-sheet-create-comment ()
  (interactive)
  (cell-with-current-cell-sheet
   (cell-push-undo-history)
   (let ((i (make-instance 'cell-comment-cell))
         (val (read-from-minibuffer "Comment expression: ")))
     (cell-set-value i val)
     (cell-grid-set grid cursor-row cursor-column i)
     (cell-sheet-update))))

(defun cell-sheet-create-image ()
  "Create an image cell at the cursor."
  (interactive)
  (cell-with-current-cell-sheet
   (cell-push-undo-history)
   (let ((i (make-instance 'cell-image-cell))
         (val (read-file-name "Image file name: ")))
     (cell-set-value i val)
     (cell-grid-set grid cursor-row cursor-column i)
     (cell-sheet-update))))

;;; Inserting rows and columns

(defun cell-sheet-insert-row ()
  "Insert a row at the cursor."
  (interactive)
  (cell-push-undo-history)
  (cell-with-current-cell-sheet 
   (setf (cell-sheet-grid cell-current-sheet) (cell-grid-insert-row grid cursor-row))
   (cell-sheet-update)))

(defun cell-sheet-insert-column ()
  "Insert a column at the cursor."
  (interactive)
  (cell-push-undo-history)
  (cell-with-current-cell-sheet
   (let ((columns (+ 1 (cell-grid-columns (cell-sheet-grid cell-current-sheet)))))
     (setf (cell-sheet-grid cell-current-sheet) (cell-grid-insert-column grid cursor-column))
     (setf (cell-sheet-column-stops cell-current-sheet) (make-vector (+ 1 columns) 0))))
  (cell-sheet-update))

;;; Deleting rows and columns

(defun cell-sheet-delete-row ()
  "Delete a row at the cursor."
  (interactive)
  (cell-push-undo-history)
  (cell-with-current-cell-sheet
   (setf (cell-sheet-grid cell-current-sheet) (cell-grid-delete-row grid cursor-row))
   (cell-sheet-update)))

(defun cell-sheet-delete-column ()
  "Delete a column at the cursor."
  (interactive)
  (cell-push-undo-history)
  (cell-with-current-cell-sheet
   (setf (cell-sheet-grid cell-current-sheet) (cell-grid-delete-column grid cursor-column))
   (cell-sheet-update)))

;;; Collecting cells

;; This is useful when you want to process the contents of a sheet. 

(defun cell-collect-cells (sheet &optional collect-all-p)
  "Return a flat list of all the cells in the SHEET."
  (let ((grid (cell-sheet-grid cell-current-sheet))
        (cell^ nil)
        (cells nil))
    (dotimes (r (cell-grid-rows grid))
      (dotimes (c (cell-grid-columns grid))
        (when (setf cell^ (cell-grid-get grid r c))
          (when (and cell^ (or collect-all-p (cell-collect-value-p cell^)))
            (push cell^ cells)))))
    (nreverse cells)))

(defun cell-collect-cells-by-row (sheet &optional collect-all-p)
  "Return a list of rows of all the cells in the SHEET."
  (let ((grid (cell-sheet-grid cell-current-sheet))
        (rows nil))
    (dotimes (r (cell-grid-rows grid))
      (let ((cell^ nil)
            (cells nil))
        (dotimes (c (cell-grid-columns grid))
          (when (setf cell^ (cell-grid-get grid r c))
            (when (and cell^ (or collect-all-p (cell-collect-value-p cell^)))
              (push cell^ cells))))
        (when cells (push (nreverse cells) rows))))
    (nreverse rows)))

(defun cell-collect-cells-by-row-include-blanks (sheet)
  "Return a list of rows of all the cells in the SHEET, with blanks."
  (let ((grid (cell-sheet-grid cell-current-sheet))
        (rows nil))
    (dotimes (r (cell-grid-rows grid))
      (let ((cell^ nil)
            (cells nil))
        (dotimes (c (cell-grid-columns grid))
          (setf cell^ (cell-grid-get grid r c))
          (push cell^ cells))
        (when cells (push (nreverse cells) rows))))
    (nreverse rows)))

(defun cell-collect-cells-by-row-no-settings (sheet)
  (let ((rows (cell-collect-cells-by-row sheet))
        (results ()))
    (dolist (row rows)
      (when (not (some #'vectorp (mapcar #'cell-find-value row)))
        (push row results)))
    (nreverse results)))

;;; Drawing

(defun cell-sheet-do-layout ()
  "Compute layout information for the cell sheet."
  (let ((widths (make-vector (cell-grid-columns (cell-sheet-grid cell-current-sheet)) 0))
        (column-width 0))
    (cell-with-current-cell-sheet
     (let ((rows (cell-grid-rows grid))
           (columns (cell-grid-columns grid)))
       ;; Find column widths and stops before rendering.
       ;; how many digits in longest row number?
       (setf (cell-sheet-row-header-width cell-current-sheet)
             (max 2 (length (format "%d" rows))))
       ;; factor in headers if needed
       (setf (aref (cell-sheet-column-stops cell-current-sheet) 0) 
             (if (cell-sheet-headers-p cell-current-sheet)
                 (cell-sheet-row-header-width cell-current-sheet)
               0))
       (dotimes (col columns)
         (setf column-width 0)
         (dotimes (row rows)
           (setf cell^ (cell-grid-get grid row col))
           (setf column-width (max column-width (if cell^
                                                    (+ 1 
                                                       (if (cell-label-width cell^)
                                                           (ceiling (cell-label-width cell^))
                                                         (length 
                                                          (if (cell-label cell^)
                                                              (cell-label cell^)
                                                            cell-no-label-string))))
                                                  cell-blank-width))))
         (setf (aref widths col) column-width)
         (when (< col columns)
           (setf (aref (cell-sheet-column-stops cell-current-sheet) (+ 1 col))
                 (+ column-width (aref (cell-sheet-column-stops cell-current-sheet) col)))))
       ;; save layout data
       (setf (cell-sheet-widths cell-current-sheet) widths)))))

(defun cell-sheet-do-redraw ()
  "Redraw the cell sheet."
  (interactive)
  (let* ((inhibit-read-only t)
         (selection-now-p nil)
         (rendering-point nil)
         (grid (cell-sheet-grid cell-current-sheet))
         (rows (cell-grid-rows grid))
         (cursor (cell-sheet-cursor cell-current-sheet))
         (mark (cell-sheet-mark cell-current-sheet))
         (cursor-row (cl-first cursor))
         (cursor-column (cl-second cursor))
         (mark-row (cl-first mark))
         (mark-column (cl-second mark))
         (columns (cell-grid-columns grid))
         (column-stops (cell-sheet-column-stops cell-current-sheet))
         (widths (cell-sheet-widths cell-current-sheet))
         (cell^ nil)
         (headers-p (cell-sheet-headers-p cell-current-sheet))
         (raw-display-p (cell-sheet-raw-display-p cell-current-sheet))
         (column-width 0)
         (cell-width 0)
         (row-header-width (cell-sheet-row-header-width cell-current-sheet))
         (face nil))
    (if raw-display-p 
        ;; just insert all the labels with \n between lines
        (progn 
          (setf cursor-type 'hollow)
          ;; (when *serialization-marker*
          ;;   (delete-region (point-min) (- (marker-position *serialization-marker*)
          ;;                              1)))
          (goto-char (point-min))
          (dotimes (row rows)
            (dotimes (col columns)
              (setf cell^ (cell-grid-get grid row col))
              (when (and cell^ (cell-label cell^))
                (insert (cell-label cell^))))
            (insert "\n"))
          ;; move cursor to right place
          (goto-char (+ 1 cursor-column 
                        (* cursor-row 
                           (+ 1 (cell-grid-columns grid)))))
          )
      ;; otherwise render everything all nice with borders and cell backgrounds. 
      ;;
      ;; Render the cell sheet into the buffer
      ;; (if cell-rendering-marker
      ;;     (delete-region (marker-position cell-rendering-marker) (point-max))
      ;;   (error "Cell-mode: No rendering marker."))
      (goto-char (point-max))
      (setf rendering-point (point))
      ;; draw headers if needed
      (when headers-p
        (cell-insert-header (cell-sheet-row-header-width cell-current-sheet) 0 :empty)
        (dotimes (col columns)
          (cell-insert-header (- (aref column-stops (+ col 1)) (aref column-stops col)) col)))
      (insert "\n")
      (dotimes (row rows)
        ;; draw headers if needed
        (when headers-p
          (cell-insert-header row-header-width row))
        ;; render
        (dotimes (col columns)
          (setf column-width (aref widths col))
          (setf cell^ (cell-grid-get grid row col))
          (when cell^
            (setf face `(,(or (cell-face cell^) 'cell-default-face)
                         ,(if (cl-evenp col) 'cell-blank-face
                            'cell-blank-odd-face))))
          ;; draw selection face if needed
          (if (cell-sheet-in-selection row col)
              (progn (setf face 'cell-selection-face)
                     (setf selection-now-p t))
            (setf selection-now-p nil))
          ;; ;; or cursor face
          ;; (when (and (= cursor-row row)
          ;;         (= cursor-column col))
          ;;   (setf face 'cell-cursor-face))
          ;; or mark face
          (when (and mark
                     (= mark-row row)
                     (= mark-column col))
            (setf face 'cell-mark-face))
          ;;
          (if cell^
              (progn
                (setf cell-width
                      (cell-insert cell^ face))
                ;; fill column if needed
                (if (cell-label-width cell^)
                    (progn 
                      (cell-insert-spacer (+ 1.0 (- (ceiling (cell-label-width cell^))
                                                    (cell-label-width cell^)))
                                          face)
                      ;;(cell-fill-space cell^ face)
                      (cell-insert-blank (- column-width (ceiling (cell-label-width cell^)) 1) face)
                      )
                  (cell-insert-blank (- column-width cell-width) face)))
            ;; blank cell
            (progn (setf face (if selection-now-p face (if (cl-evenp col) 'cell-blank-face
                                                         'cell-blank-odd-face)))
                   (setf cell-width (cell-insert-blank column-width face))))
          ;; add text properties to store row, col for mouse click
          (let* ((end (point))
                 (beg (- end column-width)))
            (put-text-property beg end 'cell-mode-position (list row col))))
        (insert "\n"))
      ;;
      (setf (cell-sheet-rendering cell-current-sheet)
            (buffer-substring rendering-point (point-max)))
      (goto-char (point-min))
      (cell-sheet-update-selection-from-mark)
      (cell-sheet-display-cursors))))

(defun cell-sheet-set-raw-display (sheet bool)
  "Enable raw display on SHEET if BOOL is non-nil."
  (setf (cell-sheet-raw-display-p cell-current-sheet) bool))

;;;; Rendering individual elements of the spreadsheet

(defun cell-insert (c &optional face)
  "Make a clickable text cell from C and insert it at point.
Returns length of inserted string.  FACE is the optional face to
use."
  (let* ((label (or (cell-label c) cell-no-label-string))
         (face (or face 'cell-default-face))
         (action `(lambda ()
                    (interactive)
                    nil)))
    (let ((str label)) 
      (insert str)
      ;; the variables ROW and COL are free in the next line.
      (setf (gethash (list row col)
                     cell-cached-buffer-positions)
            (point))
      (add-text-properties (point) (- (point) (length str))
                           `(face ,face))
      (length label))))

(defun-memo cell-cached-blank-string (width face) (:test 'equal :key 'identity)
  (propertize (make-string width ? ) 'face face))

(defun cell-insert-blank (width &optional face) 
  "Insert a blank cell WIDTH characters wide in face FACE."
  (when (> width 0)
    (insert (cell-cached-blank-string width face))
    ;; the variables ROW and COL are free in the next line.
    (setf (gethash (list row col)
                   cell-cached-buffer-positions)
          (point))
    width))

(defun cell-insert-spacer (width &optional face)
  "Insert an arbitrary WIDTH spacer with face FACE."
  (insert "Q")
  (backward-char)
  (put-text-property (point) (1+ (point)) 'display
                     `(space . (:width ,width)))
  (when face
    (put-text-property (point) (1+ (point)) 'face face))
  ;;
  (forward-char))

(defun cell-insert-header (width number &optional empty)
  "Insert a header cell of width WIDTH displaying NUMBER.
If EMPTY is non-nil, don't display the number."
  (let ((blank "")
        (label (if empty " "(format "%d" number)))
        (face (if (cl-evenp number)
                  'cell-axis-face
                'cell-axis-odd-face)))
    (dotimes (i (- width (length label)))
      (setf blank (concat blank " ")))
    (insert (propertize (concat blank label)
                        'face face))))

(defun cell-make-clickable (text action &optional face)
  "Make TEXT clickable calling function ACTION.
The optional argument FACE is the face to use." 
  (let ((keymap (make-sparse-keymap))
        (face (or face 'cell-face-red)))
    (define-key keymap [mouse-2] action)
    (propertize text
                'face face
                'keymap keymap)))

;;; Serialization

(defun cell-remove-rendering* ()
  "Remove the cell sheet's rendering without updating." 
  (let ((inhibit-read-only t))
    (when (eq major-mode 'cell-mode)
      (delete-region (point-min) (point-max)))))

(defun cell-remove-rendering ()
  "Remove the cell sheet's rendering and update."
  (when (eq major-mode 'cell-mode)
    (cell-remove-rendering*)
    (cell-sheet-update-serialization)))

(defun cell-sheet-update* ()
  "Update the cell sheet and mark the buffer non-modified."
  (when (eq major-mode 'cell-mode)
    (let ((inhibit-read-only t))
      (cell-sheet-update)
      (setf (buffer-modified-p (current-buffer)) nil))))

(defun cell-sheet-update-serialization ()
  "Rewrite the buffer contents to reflect the current data."
  (interactive)
  (let ((inhibit-read-only t))
    (cell-with-current-cell-sheet
     (save-excursion
       (delete-region (point-min) (point-max))
       (goto-char (point-min))
       ;; (setf cell-rendering-marker (point-marker))
       ;; (set-marker-insertion-type cell-rendering-marker t)
       (insert " ")
       (goto-char (point-max))
       (goto-char (point-min))
       (insert (cell-sheet-serialize cell-current-sheet))
       (goto-char (point-max))
       (insert (propertize " " 'rendering t 'display ""))
       ;;
       (goto-char (point-min))
       (let ((x (progn
                  (while (and (not (eobp))
                              (not (get-text-property (point) 'rendering)))
                    (forward-char 1))
                  (if (not (get-text-property (point) 'rendering))
                      (error "Cell-mode: could not find rendering text property")
                    (point)))))
         (add-text-properties (point-min)
                              x
                              (list 'display "")))
       (setf (buffer-modified-p (current-buffer)) nil)))))

(defun cell-sheet-update (&optional lazy)
  "Update the entire cell sheet.
If LAZY is non-nil, just redraw without updating."
  (interactive)
  (cell-with-current-cell-sheet
   (unless lazy
     (cell-sheet-update-serialization)
     (cell-sheet-do-layout))
   (cell-sheet-do-redraw)))

(defun cell-sheet-serialize (sheet)
  "Return a string version of SHEET."
  (lexical-let* ((grid (cell-sheet-grid cell-current-sheet))
                 (sheet^ cell-current-sheet)
                 (rows (cell-grid-rows grid))
                 (cols (cell-grid-columns grid))
                 (cell^ nil))
    (cl-labels ((serialize-cell (cell^ row col)
                                (format "(:cell :row %d :col %d :class %S :label %S :value %S)"
                                        row col (eieio-object-class cell^) (when (cell-label cell^)
                                                                             (substring-no-properties (cell-label cell^)))
                                        (cell-value cell^))))
      (with-temp-buffer
        (insert (format "(:sheet :name %S :rows %d :cols %d :raw-display-p %S :grid ("
                        (cell-sheet-name sheet^) rows cols (cell-sheet-raw-display-p sheet^)))
        (dotimes (row rows)
          (dotimes (col cols)
            (when (setf cell^ (cell-grid-get grid row col))
              (insert (serialize-cell cell^ row col))
              (insert "\n"))))
        (insert "\n))")
        (buffer-substring-no-properties (point-min) (point-max))))))

(defun cell-sheet-from-plist (plist &optional class)
  "Return a new cell-sheet object constructed from the data in PLIST."
  (let* ((name (cl-getf plist :name))
         (rows (cl-getf plist :rows))
         (cols (cl-getf plist :cols))
         (cells (cl-getf plist :grid))
         (raw-display-p (cl-getf plist :raw-display-p))
         (sheet^ (make-instance (or class 'cell-sheet) :name name :rows rows :cols cols))
         (grid (cell-sheet-grid cell-current-sheet))
         (cell-ob nil)
         (cell-plist nil)
         (cell^ nil))
    ;; keep raw-display-p the same
    (setf cell-current-sheet sheet^)
    (setf (cell-sheet-raw-display-p cell-current-sheet) raw-display-p)
    ;; store cells
    (while (setf cell-ob (pop cells))
      (setf cell-plist (cdr cell-ob))
      (setf cell^ (make-instance
                   (cl-getf cell-plist :class)
                   :label (cl-getf cell-plist :label)
                   :value (cl-getf cell-plist :value)
                   :face (cl-getf cell-plist :face)))
      (cell-grid-set grid 
                     (cl-getf cell-plist :row)
                     (cl-getf cell-plist :col)
                     cell^))
    cell-current-sheet))

;;; Mouse support

(defun cell-sheet-mouse-move-cursor (event)
  "Move the mouse cursor to the clicked cell.
EVENT is the mouse event data."
  (interactive "e")
  (cell-with-current-cell-sheet
   (when event
     (cl-destructuring-bind (event-type position &optional ignore) event
       (let* ((clicked-position (posn-point position))
              (clicked-cell (get-text-property clicked-position 'cell-mode-position)))
         ;;
         ;; whether we are in raw display mode
         (when (cell-sheet-raw-display-p cell-current-sheet)
           (goto-char clicked-position)
           ;;
           ;; bounds check 
           (let ((clicked-row (/ clicked-position (+ 1 (cell-grid-columns grid))))
                 (clicked-column (+ -1 (% clicked-position (+ 1 (cell-grid-columns grid))))))
             (when (and (<= 0 clicked-row)
                        (<= 0 clicked-column)
                        (< clicked-row (cell-grid-rows grid))
                        (< clicked-column (cell-grid-columns grid)))
               (setf (cell-sheet-cursor cell-current-sheet) 
                     (list clicked-row clicked-column)))))
         ;;
         ;; not in raw display
         (when clicked-cell
           (cl-destructuring-bind (clicked-row clicked-column) clicked-cell
             (setf (cell-sheet-cursor cell-current-sheet) clicked-cell)
             (when (cell-sheet-selection cell-current-sheet)
               (cell-sheet-update-selection-from-mark))
             (cell-sheet-update))))))))

(defun cell-sheet-mouse-execute (event)
  "Execute the clicked cell.  EVENT is the mouse event data."
  (interactive "e")
  (cell-with-current-cell-sheet
   (when event
     (cl-destructuring-bind (event-type position &optional ignore) event
       (let* ((clicked-position (posn-point position))
              (clicked-cell (get-text-property clicked-position 'cell-mode-position)))
         (when clicked-cell
           (cl-destructuring-bind (clicked-row clicked-column) clicked-cell
             (setf (cell-sheet-cursor cell-current-sheet) clicked-cell)
             (let ((c (cell-grid-get (cell-sheet-grid cell-current-sheet)
                                     clicked-row clicked-column)))
               (when c
                 (cell-tap c)
                 (cell-sheet-update))))))))))

(defun cell-sheet-mouse-select (event)
  "Select a cell with the mouse.  EVENT is the mouse event data."
  (interactive "e")
  (cell-with-current-cell-sheet
   (cell-sheet-clear-mark*)
   (cl-destructuring-bind (event-type position1 position2 &rest ignore) event
     (let* ((pt1 (get-text-property (posn-point position1) 'cell-mode-position))
            (pt2 (get-text-property (posn-point position2) 'cell-mode-position))
            (sel `(,@pt1 ,@pt2)))
       (setf (cell-sheet-selection cell-current-sheet) sel))
     (cell-sheet-update))))

;;; Additional commands

(defun* cell-sheet-create (&optional r0 c0 (class 'cell-sheet))
  "Create a new cell sheet with R0 rows and C0 columns."
  (interactive)
  (let ((r (or r0 (read-from-minibuffer "Create cell-sheet with how many rows? " "24")))
        (c (or c0 (read-from-minibuffer "...with how many columns? " "40"))))
    (let ((rs (car (read-from-string r)))
          (cs (car (read-from-string c))))
      (let ((buffer (generate-new-buffer "*cell sheet*")))
        (switch-to-buffer buffer)
        (cell-mode)
        (setf cell-current-sheet (make-instance class :rows rs :cols cs))
        (cell-sheet-update)))))

;;; Sheet settings are a form of local variable.

(defvar cell-sheet-class nil "Local mode class for interpreting cell sheets.")
(make-variable-buffer-local 'cell-sheet-class)

(cl-defmethod cell-sheet-collect-settings ((sheet cell-sheet))
  (let ((values (mapcar #'cell-find-value (cell-collect-cells sheet)))
        (results ()))
    (dolist (value values)
      (when (vectorp value)
        (push value results)))
    (nreverse results)))

(cl-defmethod cell-sheet-collect-settings-cells ((sheet cell-sheet))
  (let ((cells (cell-collect-cells sheet :collect-all-p))
        (results ()))
    (dolist (c cells)
      (when (vectorp (cell-find-value c))
        (push c results)))
    results))

(cl-defmethod cell-sheet-change-setting ((sheet cell-sheet) setting-name value)
  (let ((cells (cell-sheet-collect-settings-cells sheet)))
    (dolist (c cells)
      (let ((vec (cell-find-value c)))
        (when (eq setting-name (aref vec 0))
          (cell-accept-string-value c (prin1-to-string (vector setting-name value))))))))

;; (cl-defmethod cell-sheet-change-setting :after ((sheet cell-sheet) setting-name value) 
;;   (cell-sheet-update sheet)
;;   (setf (buffer-modified-p (cell-sheet-buffer sheet)) t))

(cl-defmethod cell-sheet-setting-value ((sheet cell-sheet) setting-name)
  (let ((settings (cell-sheet-collect-settings sheet)))
    (block finding
      (dolist (setting settings)
        (when (eq setting-name (aref setting 0))
          (return-from finding (aref setting 1)))))))

(defun cell-apply-settings (settings)
  (dolist (binding settings)
    (set (aref binding 0)
         (aref binding 1))))

(cl-defmethod cell-sheet-apply-settings ((sheet cell-sheet))
  (with-current-buffer (slot-value sheet 'buffer)
    (cell-apply-settings (cell-sheet-collect-settings sheet))))

(defun cell-sheet-class (sheet)
  (cell-sheet-setting-value sheet 'cell-sheet-class))

(defun cell-subclass-sheet (sheet)
  (let ((class (cell-sheet-class sheet)))
    (when (null class)
      (error "Cell-mode: no CELL-SHEET-CLASS setting in this sheet."))
    (let* ((new-sheet (make-instance class))
           (slots '(name mark rendering widths row-header-width
                         buffer cursor selection grid
                         column-stops buffer borders-p headers-p
                         raw-display-p properties)))
      (dolist (slot slots)
        (setf (slot-value new-sheet slot)
              (slot-value sheet slot)))
      new-sheet)))

(defun cell-replace-sheet (sheet)
  (with-current-buffer (slot-value sheet 'buffer)
    (setf cell-current-sheet
          (cell-subclass-sheet sheet))))

(defun cell-replace-sheet-maybe ()
  (cell-with-current-cell-sheet
   (when (cell-sheet-class cell-current-sheet)
     (cell-replace-sheet cell-current-sheet)
     (cell-sheet-after-open-hook cell-current-sheet)
     (cell-sheet-update)
     (setf (buffer-modified-p (current-buffer)) nil))))

(defun cell-insinuate ()
  (interactive)
  (add-hook 'cell-mode-hook 'cell-replace-sheet-maybe)
  (cell-start-timer))

(defun cell-sexp->cell (sexp)
  (let (cell)
    (when (and (consp sexp)
               (symbolp (first sexp))
               (ignore-errors (eieio--class-p (eieio--class-object (first sexp)))))
      (setf cell (apply #'make-instance (first sexp) (rest sexp))))
    (when (null cell)
      (setf cell (make-instance 'cell-expression
                                :value sexp
                                :label (if (stringp sexp) sexp (prin1-to-string sexp))))
      (cell-set-value cell sexp))
    cell))

(defun cell-copy-cells-from-sexps (sexps)
  (let ((rows (mapcar (lambda (row)
                        (mapcar #'cell-sexp->cell row))
                      sexps)))
    (setf cell-clipboard rows)))

;;; Customization

(defgroup cell nil
  "Options for cell-mode."
  :group 'applications)

;;; Font locking

(defface cell-default-face '((t (:foreground "black")))
  "Face for cells." :group 'cell)

(defface cell-action-face '((t (:foreground "yellow" :background "red" :bold t :weight bold)))
  "Face for cells that perform an action." :group 'cell)

(defface cell-comment-face '((t (:foreground "dodger blue")))
  "Face for cells that simply label stuff." :group 'cell)

(defface cell-comment-2-face '((t (:foreground "hot pink" :slant italic :italic t)))
  "Face for cells that simply label stuff." :group 'cell)

(defface cell-file-face '((t (:foreground "yellowgreen")))
  "Face for simple links to files." :group 'cell)

(defface cell-cursor-face '((t (:background "hot pink" :foreground "yellow"
                                            :box (:line-width 1 :color "magenta"))))
  "Face for selected cell." :group 'cell)

(defface cell-mark-face '((t (:background "yellow" :foreground "red")))
  "Face for marked cell." :group 'cell)

(defface cell-selection-face '((t (:background "pale green" :foreground "gray20"
                                               :box (:line-width 1 :color "pale green"))))
  "Face for multi-cell selection." :group 'cell)

(defface cell-text-face '((t (:foreground "yellow")))
  "Face for text entry cells." :group 'cell)

(defface cell-blank-face '((t (:background 
                               "wheat" 
                               :box 
                               (:line-width 1 :color "dark khaki"))))
  "Face for blank cells." :group 'cell)

(defface cell-blank-odd-face '((t (:background 
                                   "cornsilk" 
                                   :box 
                                   (:line-width 1 :color "dark khaki"))))
  "Face for blank cells in odd columns" :group 'cell)

(defface cell-axis-face '((t :foreground "gray50" 
                             :background "gray80" 
                             :box (:line-width 1 :color "grey70")))
  "Face for numbered axes."  :group 'cell)

(defface cell-axis-odd-face '((t :foreground "gray50" 
                                 :background "gray90" 
                                 :box (:line-width 1 :color "grey70")))
  "Face for numbered axes in odd columns." :group 'cell)

(easy-menu-define cell-menu global-map
  "Menu for Cell-mode commands."
  '("Sheet"
    ["Create or edit cell" cell-sheet-create-cell]
    ["Create comment" cell-sheet-create-comment]
    ["Undo" cell-sheet-undo]
    ["Redo" cell-sheet-redo]
    ["Set mark" cell-sheet-set-mark]
    ["Clear mark" cell-sheet-clear-mark]
    ["Delete cell at cursor" cell-sheet-delete-cell]
    ["Cut selection" cell-sheet-cut-to-clipboard]
    ["Copy selection" cell-sheet-copy-to-clipboard]
    ["Paste at cursor" cell-sheet-paste]
    ["Insert row" cell-sheet-insert-row]
    ["Insert column" cell-sheet-insert-column]
    ["Delete row" cell-sheet-delete-row]
    ["Delete column" cell-sheet-delete-column]
    ["Move cursor left" cell-sheet-move-cursor-left]
    ["Move cursor right" cell-sheet-move-cursor-right]
    ["Move cursor up" cell-sheet-move-cursor-up]
    ["Move cursor down" cell-sheet-move-cursor-down]
    ["Move to beginning of row" cell-sheet-move-bol]
    ["Move to end of row" cell-sheet-move-eol]
    ["Page up" cell-sheet-page-up]
    ["Page down" cell-sheet-page-down]
    ["Move to top left corner" cell-sheet-move-bob]
    ["Move to bottom right corner" cell-sheet-move-eob]
    ["Re-initialize buffer (fix columns)" cell-mode]))

(defvar cell-mode-tool-bar-map ())

(defun cell-enable-tool-bar-map ()
  (setf cell-mode-tool-bar-map
        (when (keymapp tool-bar-map)
          (let ((tool-bar-map (make-sparse-keymap)))
            (tool-bar-add-item
             "left-arrow" 'winner-undo 'winner-undo 
             :label "Back"
             :help "Back to previous window configuration."
             :enable t)
            (tool-bar-add-item
             "right-arrow"
             'winner-redo 'winner-redo 
             :label "Forward"
             :help "Forward to next window configuration."
             :enable t)
            (define-key-after tool-bar-map [cell-separator-1]
              (list 'menu-item "--") 'winner-redo)
            (tool-bar-add-item
             "save" 'save-buffer 'save-buffer 
             :label "Save"
             :help "Save the current sheet."
             :enable t)
            (define-key-after tool-bar-map [cell-separator-2]
              (list 'menu-item "--") 'save-buffer)
            (tool-bar-add-item
             "undo" 'cell-sheet-undo 'cell-sheet-undo
             :label "Undo"
             :help "Undo."
             :enable t)
            (tool-bar-add-item
             "cut" 'cell-sheet-redo 'cell-sheet-redo
             :label "Redo"
             :help "Redo."
             :enable t)
            (define-key-after tool-bar-map [cell-separator-3]
              (list 'menu-item "--") 'cell-sheet-redo)
            (tool-bar-add-item
             "cut" 'cell-sheet-cut-to-clipboard 'cell-sheet-cut-to-clipboard
             :label "Cut"
             :help "Cut the cells to the clipbboard."
             :enable t)
            (tool-bar-add-item
             "copy" 'cell-sheet-copy-to-clipboard 'cell-sheet-copy-to-clipboard
             :label "Copy"
             :help "Copy the cells to the clipbboard."
             :enable t)
            (tool-bar-add-item
             "paste" 'cell-sheet-paste 'cell-sheet-paste
             :label "Paste"
             :help "Paste cells from the clipboard."
             :enable t)
            tool-bar-map))))

(provide 'cell)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; cell.el ends here