Function: table-insert-column

table-insert-column is an autoloaded, interactive and byte-compiled function defined in table.el.gz.

Signature

(table-insert-column N)

Documentation

Insert N table column(s).

When point is in a table the newly inserted column(s) are placed left of the current column. When point is outside of the table it must be right side of the table within the table height range, then the newly created column(s) are appended at the right of the table.

View in manual

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/textmodes/table.el.gz
;;;###autoload
(defun table-insert-column (n)
  "Insert N table column(s).
When point is in a table the newly inserted column(s) are placed left
of the current column.  When point is outside of the table it must be
right side of the table within the table height range, then the newly
created column(s) are appended at the right of the table."
  (interactive "*p")
  (if (< n 0) (setq n 1))
  (let* ((current-coordinate (table--get-coordinate))
	 (coord-list (table--cell-list-to-coord-list (table--vertical-cell-list t nil 'left)))
	 (append-column (if coord-list nil (setq coord-list (table--find-row-column 'column))))
	 (cell-width (car (table--min-coord-list coord-list)))
	 (border-str (table--multiply-string (concat (make-string cell-width (string-to-char table-cell-horizontal-chars))
						     (char-to-string table-cell-intersection-char)) n))
	 (cell-str (table--multiply-string (concat (table--cell-blank-str cell-width)
						   (let ((str (string table-cell-vertical-char)))
						     (table--put-cell-keymap-property 0 (length str) str)
						     (table--put-cell-rear-nonsticky 0 (length str) str) str)) n))
	 (columns-to-extend (* n (+ 1 cell-width)))
	 (above-list nil)
	 (this-list coord-list)
	 (below-list (cdr coord-list))
	 (right-border-x (car (table--get-coordinate (cdr (table--horizontal-cell-list nil t))))))
    ;; push back the affected area above and below this table
    (table--horizontally-shift-above-and-below columns-to-extend coord-list)
    ;; process each cell vertically from top to bottom
    (while this-list
      (let* ((above (prog1 (car above-list) (setq above-list (if above-list (cdr above-list) coord-list))))
	     (this (prog1 (car this-list) (setq this-list (cdr this-list))))
	     (below (prog1 (car below-list) (setq below-list (cdr below-list))))
	     (exclude-above (and above (<= (caar above) (caar this))))
	     (exclude-below (and below (< (caar below) (caar this))))
	     (beg-coord (cons (if append-column (1+ right-border-x) (caar this))
			      (if exclude-above (cdar this) (1- (cdar this)))))
	     (end-coord (cons (1+ right-border-x)
			      (if exclude-below (cddr this) (1+ (cddr this)))))
	     rect)
	;; untabify the area right of the bar that is about to be inserted
	(let ((coord (table--copy-coordinate beg-coord))
	      (i 0)
	      (len (length rect)))
	  (while (< i len)
	    (if (table--goto-coordinate coord 'no-extension)
		(table--untabify-line (point)))
	    (setcdr coord (1+ (cdr coord)))
	    (setq i (1+ i))))
	;; extract and delete the rectangle area including the current
	;; cell and to the right border of the table.
	(setq rect (extract-rectangle (table--goto-coordinate beg-coord)
				      (table--goto-coordinate end-coord)))
	(delete-rectangle (table--goto-coordinate beg-coord)
			  (table--goto-coordinate end-coord))
	;; prepend the empty column string at the beginning of each
	;; rectangle string extracted before.
	(let ((rect-str rect)
	      (first t))
	  (while rect-str
	    (if (and first (null exclude-above))
		(setcar rect-str (concat border-str (car rect-str)))
	      (if (and (null (cdr rect-str)) (null exclude-below))
		  (setcar rect-str (concat border-str (car rect-str)))
		(setcar rect-str (concat cell-str (car rect-str)))))
	    (setq first nil)
	    (setq rect-str (cdr rect-str))))
	;; insert the extended rectangle
	(table--goto-coordinate beg-coord)
	(table--insert-rectangle rect)))
    ;; fix up the intersections
    (setq this-list (if append-column nil coord-list))
    (while this-list
      (let ((this (prog1 (car this-list) (setq this-list (cdr this-list))))
	    (i 0))
	(while (< i n)
	  (let ((x (1- (* (1+ i) (+ 1 cell-width)))))
	    (table--goto-coordinate (table--offset-coordinate (car this) (cons x  -1)))
	    (delete-char 1) (insert table-cell-intersection-char)
	    (table--goto-coordinate (table--offset-coordinate (cons (caar this) (cddr this)) (cons x  1)))
	    (delete-char 1) (insert table-cell-intersection-char)
	    (setq i (1+ i))))))
    ;; move the point to the beginning of the first newly inserted cell.
    (if (table--goto-coordinate
	 (if append-column
	     (cons (1+ right-border-x)
		   (cdar (car coord-list)))
	   (caar coord-list))) nil
      (table--goto-coordinate current-coordinate))
    ;; re-recognize the current cell's new dimension
    (table-recognize-cell 'force)))