Function: ses-yank-cells

ses-yank-cells is a byte-compiled function defined in ses.el.gz.

Signature

(ses-yank-cells TEXT ARG)

Documentation

If TEXT has a proper set of ses attributes, insert it as cells.

Otherwise, return nil. The cells are reprinted--the supplied text is ignored because the column widths, default printer, etc. at yank time might be different from those at kill-time. ARG is a list to indicate that formulas are to be inserted without relocation.

Source Code

;; Defined in /usr/src/emacs/lisp/ses.el.gz
(defun ses-yank-cells (text arg)
  "If TEXT has a proper set of `ses' attributes, insert it as cells.
Otherwise, return nil.  The cells are reprinted--the supplied text is
ignored because the column widths, default printer, etc. at yank time might
be different from those at kill-time.  ARG is a list to indicate that
formulas are to be inserted without relocation."
  (let ((first (get-text-property 0 'ses text))
	(last  (get-text-property (1- (length text)) 'ses text)))
    (when (and first last) ;;Otherwise not proper set of attributes
      (setq first    (ses-sym-rowcol (car first))
	    last     (ses-sym-rowcol (car last)))
      (let* ((needrows (- (car last) (car first) -1))
	     (needcols (- (cdr last) (cdr first) -1))
	     (rowcol   (ses-yank-resize needrows needcols))
	     (rowincr  (- (car rowcol) (car first)))
	     (colincr  (- (cdr rowcol) (cdr first)))
	     (pos      0)
	     myrow mycol x)
	(dotimes-with-progress-reporter (row needrows) "Yanking..."
	  (setq myrow (+ row (car rowcol)))
	  (dotimes (col needcols)
	    (setq mycol (+ col (cdr rowcol))
		  last (get-text-property pos 'ses text)
		  pos  (next-single-property-change pos 'ses text)
		  x    (ses-sym-rowcol (car last)))
	    (if (not last)
		;; Newline --- all remaining cells on row are skipped.
		(setq x   (cons (- myrow rowincr) (+ needcols colincr -1))
		      last (list nil nil nil)
		      pos  (1- pos)))
	    (if (/= (car x) (- myrow rowincr))
		(error "Cell row error"))
	    (if (< (- mycol colincr) (cdr x))
		;; Some columns were skipped.
		(let ((oldcol mycol))
		  (while (< (- mycol colincr) (cdr x))
		    (ses-clear-cell myrow mycol)
		    (setq col   (1+ col)
			  mycol (1+ mycol)))
		  (ses-print-cell myrow (1- oldcol)))) ;; This inserts *skip*.
	    (when (car last) ; Skip this for *skip* cells.
	      (setq x (nth 2 last))
	      (unless (equal x (ses-cell-printer myrow mycol))
		(or (not x)
		    (stringp x)
		    (eq (car-safe x) 'ses-safe-printer)
		    (setq x `(ses-safe-printer ,x)))
		(ses-set-cell myrow mycol 'printer x))
	      (setq x (cadr last))
	      (if (atom arg)
		  (setq x (ses-relocate-formula x 0 0 rowincr colincr)))
	      (or (atom x)
		  (eq (car-safe x) 'ses-safe-formula)
		  (setq x `(ses-safe-formula ,x)))
	      (ses-cell-set-formula myrow mycol x)))
	  (when pos
	    (if (get-text-property pos 'ses text)
		(error "Missing newline between rows"))
	    (setq pos (next-single-property-change pos 'ses text))))
	t))))