Function: table-split-cell-horizontally

table-split-cell-horizontally is an autoloaded, interactive and byte-compiled function defined in table.el.gz.

Signature

(table-split-cell-horizontally)

Documentation

Split current cell horizontally.

Creates a cell on the left and a cell on the right of the current point location.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/textmodes/table.el.gz
;;;###autoload
(defun table-split-cell-horizontally ()
  "Split current cell horizontally.
Creates a cell on the left and a cell on the right of the current
point location."
  (interactive "*")
  (table-recognize-cell 'force)
  (let* ((o-coordinate (table--get-coordinate))
	 (point-x (car o-coordinate))
	 cell-empty cell-contents cell-coordinate
	 contents-to beg end rectangle strip-rect
	 (right-edge (= (car o-coordinate) (1- (car table-cell-info-rb-coordinate)))))
    (unless (table--cell-can-split-horizontally-p)
      (error "Can't split here"))
    (let ((table-inhibit-update t))
      (table-with-cache-buffer
	(setq cell-coordinate (table--get-coordinate))
	(save-excursion
	  (goto-char (point-min))
	  (setq cell-empty (null (re-search-forward "\\S " nil t))))
	(setq cell-contents (buffer-substring (point-min) (point-max)))
	(setq table-inhibit-auto-fill-paragraph t)))
    (setq contents-to
	  (if cell-empty 'left
	    (let* ((completion-ignore-case t)
		   (default (car table-cell-split-contents-to-history)))
	      (intern
	       (if (member 'click (event-modifiers last-input-event))
		   (x-popup-menu last-input-event
				 '("Existing cell contents to:"
				   ("Title"
				    ("Split" . "split") ("Left" . "left") ("Right" . "right"))))
		 (downcase (completing-read
			    (format-prompt "Existing cell contents to" default)
			    '(("split") ("left") ("right"))
			    nil t nil 'table-cell-split-contents-to-history default)))))))
    (unless (eq contents-to 'split)
      (table-with-cache-buffer
	(erase-buffer)
	(setq table-inhibit-auto-fill-paragraph t)))
    (table--update-cell 'now)
    (setq beg (table--goto-coordinate
	       (cons point-x
		     (1- (cdr table-cell-info-lu-coordinate)))))
    (setq end (table--goto-coordinate
	       (cons (1+ point-x)
		     (1+ (cdr table-cell-info-rb-coordinate)))))
    (setq rectangle (cons (char-to-string table-cell-intersection-char) nil))
    (let ((n table-cell-info-height))
      (while (prog1 (> n 0) (setq n (1- n)))
	(setq rectangle (cons (char-to-string table-cell-vertical-char) rectangle))))
    (setq rectangle (cons (char-to-string table-cell-intersection-char) rectangle))
    (if (eq contents-to 'split)
	(setq strip-rect (extract-rectangle beg end)))
    (delete-rectangle beg end)
    (goto-char beg)
    (table--insert-rectangle rectangle)
    (table--goto-coordinate o-coordinate)
    (if cell-empty
	(progn
	  (forward-char 1)
	  (if right-edge
	      (table-widen-cell 1)))
      (unless (eq contents-to 'left)
	(forward-char 1))
      (table-recognize-cell 'force)
      (table-with-cache-buffer
	(if (eq contents-to 'split)
	    ;; split inserts strip-rect after removing
	    ;; top and bottom borders
	    (let ((o-coord (table--get-coordinate))
		  (l (setq strip-rect (cdr strip-rect))))
	      (while (cddr l) (setq l (cdr l)))
	      (setcdr l nil)
	      ;; insert the strip only when it is not a completely blank one
	      (unless (let ((cl (mapcar (lambda (s) (string= s " ")) strip-rect)))
			(and (car cl)
			     (table--uniform-list-p cl)))
		(goto-char (point-min))
		(table--insert-rectangle strip-rect)
		(table--goto-coordinate o-coord)))
	  ;; left or right inserts original contents
	  (erase-buffer)
	  (insert cell-contents)
	  (table--goto-coordinate cell-coordinate)
	  (table--fill-region (point-min) (point-max))
	  ;; avoid unnecessary vertical cell expansion
	  (and (looking-at "\\s *\\'")
	       (re-search-backward "\\S \\(\\s *\\)\\=" nil t)
	       (goto-char (match-beginning 1))))
	;; in either case do not fill paragraph
	(setq table-inhibit-auto-fill-paragraph t))
      (table--update-cell 'now)) ;; can't defer this operation
    (table-recognize-cell 'force)))