Function: ses-relocate-all

ses-relocate-all is a byte-compiled function defined in ses.el.gz.

Signature

(ses-relocate-all MINROW MINCOL ROWINCR COLINCR)

Documentation

Alter all cell values, symbols, formulas, and reference-lists to relocate the rectangle (MINROW,MINCOL)..(NUMROWS,NUMCOLS) by adding ROWINCR and COLINCR to each symbol.

Source Code

;; Defined in /usr/src/emacs/lisp/ses.el.gz
(defun ses-relocate-all (minrow mincol rowincr colincr)
  "Alter all cell values, symbols, formulas, and reference-lists to relocate
the rectangle (MINROW,MINCOL)..(NUMROWS,NUMCOLS) by adding ROWINCR and COLINCR
to each symbol."
  (let (reform)
    (let (mycell newval xrow)
      (dotimes-with-progress-reporter
	  (row ses--numrows) "Relocating formulas..."
	(dotimes (col ses--numcols)
	  (setq ses-relocate-return nil
		mycell (ses-get-cell row col)
		newval (ses-relocate-formula (ses-cell-formula mycell)
					     minrow mincol rowincr colincr)
		xrow  (- row rowincr))
	  (ses-set-cell row col 'formula newval)
	  (if (eq ses-relocate-return 'range)
	      ;; This cell contains a (ses-range X Y) where a cell has been
	      ;; inserted or deleted in the middle of the range.
	      (push (cons row col) reform))
	  (if ses-relocate-return
	      ;; This cell referred to a cell that's been deleted or is no
	      ;; longer part of the range.  We can't fix that now because
	      ;; reference lists cells have been partially updated.
	      (cl-pushnew (ses-create-cell-symbol row col)
                          ses--deferred-recalc :test #'equal))
	  (setq newval (ses-relocate-formula (ses-cell-references mycell)
					     minrow mincol rowincr colincr))
	  (ses-set-cell row col 'references newval)
	  (and (>= row minrow) (>= col mincol)
	       (let ((sym (ses-cell-symbol row col))
		     (xcol (- col colincr)))
		 (if (and
		      sym
		      (>= xrow 0)
		      (>= xcol 0)
                      ;; the following could also be tested as
		      ;; (null (eq sym (ses-create-cell-symbol xrow xcol)))
                      (eq (get sym 'ses-cell) :ses-named))
		     ;; This is a renamed cell, do not update the cell
		     ;; name, but just update the coordinate property.
                     (puthash sym (cons row col) ses--named-cell-hashmap)
		   (ses-set-cell row col 'symbol
				 (setq sym (ses-create-cell-symbol row col)))
		   (unless (local-variable-if-set-p sym)
		     (set (make-local-variable sym) nil)
		     (put sym 'ses-cell (cons row col)))))) )))
    ;; Relocate the cell values.
    (let (oldval myrow mycol xrow xcol sym)
      (cond
       ((and (<= rowincr 0) (<= colincr 0))
	;; Deletion of rows and/or columns.
	(dotimes-with-progress-reporter
	    (row (- ses--numrows minrow)) "Relocating variables..."
	  (setq myrow  (+ row minrow))
	  (dotimes (col (- ses--numcols mincol))
	    (setq mycol  (+ col mincol)
		  xrow   (- myrow rowincr)
		  xcol   (- mycol colincr)
                  sym (ses-cell-symbol myrow mycol))
	    ;; We don't need to relocate value for renamed cells, as they keep the same
	    ;; symbol.
	    (unless (eq (get sym 'ses-cell) :ses-named)
	      (ses-set-cell myrow mycol 'value
			    (if (and (< xrow ses--numrows) (< xcol ses--numcols))
				(ses-cell-value xrow xcol)
			      ;; Cell is off the end of the array.
			      (symbol-value (ses-create-cell-symbol xrow xcol)))))))
	(when ses--in-killing-named-cell-list
	  (message "Unbinding killed named cell symbols...")
	  (setq ses-start-time (float-time))
	  (while ses--in-killing-named-cell-list
	    (ses--time-check "Unbinding killed named cell symbols... (%d left)" (length ses--in-killing-named-cell-list))
	    (ses--unbind-cell-name (pop ses--in-killing-named-cell-list)) )
	  (message nil)) )

       ((and (wholenump rowincr) (wholenump colincr))
	;; Insertion of rows and/or columns.  Run the loop backwards.
	(let ((disty (1- ses--numrows))
	      (distx (1- ses--numcols))
	      myrow mycol)
	  (dotimes-with-progress-reporter
	      (row (- ses--numrows minrow)) "Relocating variables..."
	    (setq myrow (- disty row))
	    (dotimes (col (- ses--numcols mincol))
	      (setq mycol (- distx col)
		    xrow  (- myrow rowincr)
		    xcol  (- mycol colincr)
                    sym (ses-cell-symbol myrow mycol))
	      ;; We don't need to relocate value for renamed cells, as they keep the same
	      ;; symbol.
	      (unless (eq (get sym 'ses-cell) :ses-named)
                (if (or (< xrow minrow) (< xcol mincol))
		    ;; Newly-inserted value.
		    (setq oldval nil)
		  ;; Transfer old value.
		  (setq oldval (ses-cell-value xrow xcol)))
                (ses-set-cell myrow mycol 'value oldval))))
	  t))  ; Make testcover happy by returning non-nil here.
       (t
	(error "ROWINCR and COLINCR must have the same sign"))))
    ;; Reconstruct reference lists for cells that contain ses-ranges that have
    ;; changed size.
    (when reform
      (message "Fixing ses-ranges...")
      (let (row col)
	(setq ses-start-time (float-time))
	(while reform
	  (ses--time-check "Fixing ses-ranges... (%d left)" (length reform))
	  (setq row    (caar reform)
		col    (cdar reform)
		reform (cdr reform))
	  (ses-cell-set-formula row col (ses-cell-formula row col))))
      (message nil))))