Function: calc-do-grab-rectangle

calc-do-grab-rectangle is an autoloaded and byte-compiled function defined in calc-yank.el.gz.

Signature

(calc-do-grab-rectangle TOP BOT ARG &optional REDUCE)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-yank.el.gz
(defun calc-do-grab-rectangle (top bot arg &optional reduce)
  (and (memq major-mode '(calc-mode calc-trail-mode))
       (error "This command works only in a regular text buffer"))
  (let* ((col1 (save-excursion (goto-char top) (current-column)))
	 (col2 (save-excursion (goto-char bot) (current-column)))
	 (from-buffer (current-buffer))
	 (calc-was-started (get-buffer-window "*Calculator*"))
	 data mat vals lnum pt pos)
    (if (= col1 col2)
	(save-excursion
	  (unless (= col1 0)
	    (error "Point and mark must be at beginning of line, or define a rectangle"))
	  (goto-char top)
	  (while (< (point) bot)
	    (setq pt (point))
	    (forward-line 1)
	    (setq data (cons (buffer-substring pt (1- (point))) data)))
	  (setq data (nreverse data)))
      (setq data (extract-rectangle top bot)))
    (calc)
    (setq mat (list 'vec)
	  lnum 0)
    (when arg
      (setq arg (if (consp arg) 0 (prefix-numeric-value arg))))
    (while data
      (if (natnump arg)
	  (progn
	    (if (= arg 0)
		(setq arg 1000000))
	    (setq pos 0
		  vals (list 'vec))
	    (let ((w (length (car data)))
		  j v)
	      (while (< pos w)
		(setq j (+ pos arg)
		      v (if (>= j w)
			    (math-read-expr (substring (car data) pos))
			  (math-read-expr (substring (car data) pos j))))
		(if (eq (car-safe v) 'error)
		    (setq vals v w 0)
		  (setq vals (nconc vals (list v))
			pos j)))))
	(if (string-match "\\` *-?[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]? *\\'"
			  (car data))
	    (setq vals (list 'vec (string-to-number (car data))))
	  (if (and (null arg)
		   (string-match "[[{][^][{}]*[]}]" (car data)))
	      (setq pos (match-beginning 0)
		    vals (math-read-expr (math-match-substring (car data) 0)))
	    (let ((s (if (string-match
			  "\\`\\([0-9]+:[ \t]\\)?\\(.*[^, \t]\\)[, \t]*\\'"
			  (car data))
			 (math-match-substring (car data) 2)
		       (car data))))
	      (setq pos -1
		    vals (math-read-expr (concat "[" s "]")))
	      (if (eq (car-safe vals) 'error)
		  (let ((v2 (math-read-expr s)))
		    (unless (eq (car-safe v2) 'error)
		      (setq vals (list 'vec v2)))))))))
      (if (eq (car-safe vals) 'error)
	  (progn
	    (if calc-was-started
		(pop-to-buffer from-buffer)
	      (calc-quit t)
	      (switch-to-buffer from-buffer))
	    (goto-char top)
	    (forward-line lnum)
	    (forward-char (+ (nth 1 vals) (min col1 col2) pos))
	    (error (nth 2 vals))))
      (unless (equal vals '(vec))
	(setq mat (cons vals mat)))
      (setq data (cdr data)
	    lnum (1+ lnum)))
    (calc-slow-wrapper
     (if reduce
	 (calc-enter-result 0 "grb+" (list reduce '(var add var-add)
					   (nreverse mat)))
       (calc-enter-result 0 "grab" (nreverse mat))))))