Function: markdown-ts-table-insert-column

markdown-ts-table-insert-column is an interactive and byte-compiled function defined in markdown-ts-mode.el.gz.

Signature

(markdown-ts-table-insert-column &optional LEFT CLONE)

Documentation

Insert a table column after point's current column.

If LEFT is non-nil and is not right, or with a prefix argument, insert the column to the left of the current column. If CLONE is non-nil, clone the current column, otherwise insert empty cells. If CLONE is a list, its first element is target-column-number. It is the caller's responsibility that this value is valid for the table, though it may be invalid for a non-uniform ragged row. Point can be in the table header or body. If point is not at a table, do nothing.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/textmodes/markdown-ts-mode.el.gz
(defun markdown-ts-table-insert-column (&optional left clone)
  "Insert a table column after point's current column.
If LEFT is non-nil and is not `right', or with a prefix argument,
insert the column to the left of the current column.
If CLONE is non-nil, clone the current column, otherwise insert empty
cells.
If CLONE is a list, its first element is target-column-number.  It is
the caller's responsibility that this value is valid for the table,
though it may be invalid for a non-uniform ragged row.
Point can be in the table header or body.
If point is not at a table, do nothing."
  (interactive)
  (markdown-ts--barf-if-not-mode 'markdown-ts-table-insert-column)
  (setq left (cond ((eq left 'right) nil)
                   (left left)
                   (current-prefix-arg t)))
  (when-let* ((at-table (markdown-ts-at-table-p nil t))
              (pos (car at-table))
              (table (cdr at-table))
              (delimiter-row (treesit-search-subtree
                              table "\\`pipe_table_delimiter_row\\'"))
              ;; Column pos for inserting missing leading pipes.
              (delim0-pipe-col
               (save-excursion
                 (let* ((delim-cell (treesit-node-child
                                     delimiter-row 0 'named))
                        (beg (treesit-node-start delim-cell)))
                   (goto-char beg)
                   (goto-char (pos-bol))
                   (if (search-forward "|" beg t)
                       (1- (current-column))
                     (goto-char beg)
                     (current-column)))))
              (node (treesit-node-at pos 'markdown 'named))
              (cell (markdown-ts--table-node-cell node))
              (point-row (markdown-ts--table-node-row cell)))
    (let ((table-column (markdown-ts--table-compute-node-column point-row cell)))
      (unless table-column
        (error "Could not compute the table column"))
      ;; NOTE: GFM tables allow non-uniform table rows.  The current row
      ;; could have a differing number of columns from other rows.  We
      ;; silently do nothing to a row that does not extend to the
      ;; computed column.
      ;;
      ;; NOTE: The grammar annoyingly ignores cell leading whitespace
      ;; but includes trailing whitespace, so cells are bounded by the
      ;; first graph character up to the last character just before the
      ;; pipe symbol, including whitespace.  The result is the range
      ;; does not start immediately after the optional leading pipe
      ;; symbol yet inconsistently continues until just before the
      ;; trailing pipe.
      (let* ((adj 0) ; Adjust node position offsets by inserted text.
             (width markdown-ts-table-default-column-width)
             (empty (make-string width ?\s))
             ;; TODO: Remove the placeholder character if the tree-sitter
             ;; grammar is repaired.
             (placeholder (concat "." (make-string (1- width) ?\s)))
             (delim (make-string width ?-))
             (rows (treesit-node-children table 'named))
             (nrows (length rows))
             (target-column-number (and (listp clone) (car clone)))
             ;; Position to move point to after all rows have been
             ;; updated.  Deterministic placement avoids depending on
             ;; tree-sitter navigation through freshly-inserted empty
             ;; cells, which the grammar does not always reparse as
             ;; pipe_table_cell nodes.
             (target-pos))
        ;; TODO: Remove after bug#23903 Undo after kb differs from after M-x
        (push (point) buffer-undo-list)
        (save-excursion
          (without-restriction
            (dotimes (x nrows)
              (when-let* ((row (nth x rows))
                          (row-type (treesit-node-type row))
                          (cols (treesit-node-children row 'named))
                          (ncols (length cols))
                          ;; source-cell will be nil if table-column is beyond this
                          ;; row's column set and that row will be skipped.
                          (source-cell (nth table-column cols))
                          ;; If cloning with a specified target-column-number,
                          ;; target-cell will be nil and the row will be skipped.
                          (target-cell (if target-column-number
                                          (nth target-column-number cols)
                                        source-cell))
                          ;; Compute the insertion point.
                          (beg (cond
                                ;; If cloning to a specified target, use
                                ;; target-cell's end.
                                (target-column-number
                                 (+ adj
                                    (treesit-node-end target-cell)))
                                ;; If inserting to the left of the first
                                ;; column, use source cell's start
                                ;; adjusted for its optional pipe to
                                ;; capture its whitespace.  If there is
                                ;; no pipe, use bol.
                                ((and left (eq table-column 0))
                                 (let ((p (+ adj
                                             (treesit-node-start source-cell))))
                                   (goto-char p)
                                   (goto-char (pos-bol))
                                   (if (search-forward "|" p t)
                                       (setq p (1- (point)))
                                     (setq p (pos-bol)))
                                   p))
                                ;; If inserting left and any other
                                ;; column, use the end of the prior
                                ;; cell.
                                (left
                                 (+ adj
                                    (1+ (treesit-node-end
                                         (nth (1- table-column) cols)))))
                                ;; If inserting right, use the end of
                                ;; the current cell.
                                (t
                                 (+ adj
                                    (treesit-node-end source-cell))))))
                (goto-char beg)
                (let* ((orig-point (point))
                       (missing-leading-pipe
                        (when (eq table-column 0)
                          (save-excursion
                            (goto-char (pos-bol))
                            (unless (search-forward
                                     "|"
                                     (+ adj (treesit-node-start source-cell)) t)
                              "|"))))
                       (text (cond
                              ;; If cloning, retrieve the source cell text.
                              (clone (buffer-substring-no-properties
                                      ;; Back up to bol or the pipe
                                      ;; to capture the whitespace
                                      ;; the grammar leaves out.
                                      (save-excursion
                                        (goto-char
                                         (+ adj
                                            (treesit-node-start source-cell)))
                                        (skip-chars-backward "[[:blank:]]"
                                                             (pos-bol))
                                        (point))
                                      (+ adj (treesit-node-end source-cell))))
                              ;; If new column, and this is the
                              ;; delimiter row, insert a default
                              ;; delimiter.
                              ((equal row-type "pipe_table_delimiter_row")
                               delim)
                              ;; If new column, and this is the a header
                              ;; or body row, insert a default empty
                              ;; string.
                              (t
                               empty))))
                  (cond
                   (clone
                    (cond
                    ;; Clone the first column to the left.  If there is
                    ;; no pipe before the cell content, insert one.
                     ((and left (eq table-column 0))
                        (insert "|"
                                text
                                (or missing-leading-pipe "")))
                    ;; Clone the first column to the right.
                     ((and (not left) (eq table-column 0))
                      (insert "|"
                              text)
                      ;; For a positive user experience given grammar
                      ;; bugs, add a missing leading pipe to the first
                      ;; cell at a pleasing position after cloning.
                      (when missing-leading-pipe
                        (save-excursion
                          (move-to-column delim0-pipe-col)
                          (insert "|"))))
                    ;; Clone the final column to the left.
                     ((and left (eq table-column (1- ncols)))
                      (insert text
                              "|"))
                     ;; Clone a middle column to the left.
                     (left
                      (insert text
                              "|"))
                     ;; Clone a middle or final column to the right.
                     (t
                      (insert "|"
                              text))))

                   ;; Not cloning, insert a new column.
                   ((and left (eq table-column 0) (eq x (1- nrows))
                         (not (equal row-type "pipe_table_delimiter_row")))
                   ;; TODO: remove placeholder logic.
                    (insert
                     "|"
                     placeholder
                     (or missing-leading-pipe "")))
                   ((and left (eq table-column 0))
                      (insert
                       "|"
                       text
                       (or missing-leading-pipe "")))
                   (left
                    (insert
                     text
                     "|"))
                   (t
                    (insert
                     "|"
                     text)))

                  ;; Capture the start of the new cell's content in
                  ;; the row that originally contained point.
                  (when (and (not target-pos)
                             (treesit-node-eq row point-row))
                    (setq target-pos
                          (cond
                           (target-column-number
                            (treesit-node-start target-cell))
                           (t
                            (if (and left (not (eq table-column 0)))
                                ;; "text |" inserted at beg.
                                orig-point
                              ;; All other branches insert "|" first.
                              (1+ orig-point))))))

                  ;; Adjust offset for deleted text.
                  (setq adj (+ adj (- (point) orig-point))
                        orig-point (point)))))))
        (when target-pos
          (goto-char target-pos))))))