Function: table-span-cell

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

Signature

(table-span-cell DIRECTION)

Documentation

Span current cell into adjacent cell in DIRECTION.

DIRECTION is one of symbols; right, left, above or below.

View in manual

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/textmodes/table.el.gz
;;;###autoload
(defun table-span-cell (direction)
  "Span current cell into adjacent cell in DIRECTION.
DIRECTION is one of symbols; right, left, above or below."
  (interactive
   (list
    (let* ((_ (barf-if-buffer-read-only))
	   (direction-list
	    (let* ((tmp (delete nil
				(mapcar (lambda (d)
					  (if (table--cell-can-span-p d)
					      (list (symbol-name d))))
					'(right left above below)))))
	      (if (null tmp)
		  (error "Can't span this cell"))
	      tmp))
	   (default-direction  (if (member (list (car table-cell-span-direction-history)) direction-list)
				   (car table-cell-span-direction-history)
				 (caar direction-list)))
	   (completion-ignore-case t))
      (intern (downcase (completing-read
			 (format-prompt "Span into" default-direction)
			 direction-list
			 nil t nil 'table-cell-span-direction-history default-direction))))))
  (unless (memq direction '(right left above below))
    (error "Invalid direction %s, must be right, left, above or below"
	   (symbol-name direction)))
  (table-recognize-cell 'force)
  (unless (table--cell-can-span-p direction)
    (error "Can't span %s" (symbol-name direction)))
  ;; Prepare beginning and end positions of the border bar to strike through.
  (let ((beg (save-excursion
               (table--goto-coordinate
                (cond
                 ((eq direction 'right)
		  (cons (car table-cell-info-rb-coordinate)
			(1- (cdr table-cell-info-lu-coordinate))))
                 ((eq direction 'below)
		  (cons (1- (car table-cell-info-lu-coordinate))
			(1+ (cdr table-cell-info-rb-coordinate))))
                 (t
		  (cons (1- (car table-cell-info-lu-coordinate))
			(1- (cdr table-cell-info-lu-coordinate)))))
                'no-extension)))
	(end (save-excursion
               (table--goto-coordinate
                (cond
                 ((eq direction 'left)
		  (cons (car table-cell-info-lu-coordinate)
			(1+ (cdr table-cell-info-rb-coordinate))))
                 ((eq direction 'above)
		  (cons (1+ (car table-cell-info-rb-coordinate))
			(1- (cdr table-cell-info-lu-coordinate))))
                 (t
		  (cons (1+ (car table-cell-info-rb-coordinate))
			(1+ (cdr table-cell-info-rb-coordinate)))))
                'no-extension))))
    ;; Replace the bar with blank space while taking care of edges to be border
    ;; or intersection.
    (save-excursion
      (goto-char beg)
      (if (memq direction '(left right))
	  (let* ((column (current-column))
		 rectangle
		 (n-element (- (length (extract-rectangle beg end)) 2))
		 (above-contp (and (goto-char beg)
				   (zerop (forward-line -1))
				   (= (move-to-column column) column)
				   (looking-at (regexp-quote (char-to-string table-cell-vertical-char)))))
		 (below-contp (and (goto-char end)
				   (progn (forward-char -1) t)
				   (zerop (forward-line 1))
				   (= (move-to-column column) column)
				   (looking-at (regexp-quote (char-to-string table-cell-vertical-char))))))
	    (setq rectangle
		  (cons (if below-contp
			    (char-to-string table-cell-intersection-char)
			  (substring table-cell-horizontal-chars 0 1))
			rectangle))
	    (while (> n-element 0)
	      (setq rectangle (cons (table--cell-blank-str 1) rectangle))
	      (setq n-element (1- n-element)))
	    (setq rectangle
		  (cons (if above-contp
			    (char-to-string table-cell-intersection-char)
			  (substring table-cell-horizontal-chars 0 1))
			rectangle))
	    (delete-rectangle beg end)
	    (goto-char beg)
	    (table--insert-rectangle rectangle))
	(delete-region beg end)
	(insert (if (and (> (point) (point-min))
			 (save-excursion
			   (forward-char -1)
			   (looking-at (regexp-opt-charset
					(string-to-list table-cell-horizontal-chars)))))
		    table-cell-intersection-char
		  table-cell-vertical-char)
		(table--cell-blank-str (- end beg 2))
		(if (looking-at (regexp-opt-charset
				 (string-to-list table-cell-horizontal-chars)))
		    table-cell-intersection-char
		  table-cell-vertical-char))))
    ;; recognize the newly created spanned cell
    (table-recognize-cell 'force)
    (if (member direction '(right left))
	(table-with-cache-buffer
	  (table--fill-region (point-min) (point-max))
	  (setq table-inhibit-auto-fill-paragraph t)))))