Function: org-columns-dblock-write-default

org-columns-dblock-write-default is a byte-compiled function defined in org-colview.el.gz.

Signature

(org-columns-dblock-write-default IPOS TABLE PARAMS)

Documentation

Write out a columnview table at position IPOS in the current buffer.

TABLE is a table with data as produced by org-columns--capture-view. PARAMS is the parameter property list obtained from the dynamic block definition.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-colview.el.gz
(defun org-columns-dblock-write-default (ipos table params)
  "Write out a columnview table at position IPOS in the current buffer.
TABLE is a table with data as produced by `org-columns--capture-view'.
PARAMS is the parameter property list obtained from the dynamic block
definition."
  (let ((link (plist-get params :link))
	(width-specs
	 (mapcar (lambda (spec) (nth 2 spec))
		 org-columns-current-fmt-compiled)))
    (when table
      ;; Prune level information from the table.  Also normalize
      ;; headings: remove stars, add indentation entities, if
      ;; required, and possibly precede some of them with a horizontal
      ;; rule.
      (let ((item-index
	     (let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
	       (and p (cl-position p
				   org-columns-current-fmt-compiled
				   :test #'equal))))
	    (hlines (plist-get params :hlines))
	    (indent (plist-get params :indent))
	    new-table)
	;; Copy header and first rule.
	(push (pop table) new-table)
	(push (pop table) new-table)
	(dolist (row table (setq table (nreverse new-table)))
	  (let ((level (car row)))
	    (when (and (not (eq (car new-table) 'hline))
		       (or (eq hlines t)
			   (and (numberp hlines) (<= level hlines))))
	      (push 'hline new-table))
	    (when item-index
	      (let* ((raw (nth item-index (cdr row)))
		     (cleaned (org-columns--clean-item raw))
		     (item (if (not link) cleaned
			     (let ((search (org-link-heading-search-string raw)))
			       (org-link-make-string
				(if (not (buffer-file-name)) search
				  (format "file:%s::%s" (buffer-file-name) search))
				cleaned)))))
		(setf (nth item-index (cdr row))
		      (if (and indent (> level 1))
			  (concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
			item))))
	    (push (cdr row) new-table))))
      (when (plist-get params :vlines)
	(setq table
	      (let ((size (length org-columns-current-fmt-compiled)))
		(append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x)))
				table)
			(list (cons "/" (make-list size "<>")))))))
      (when (seq-find #'identity width-specs)
        ;; There are width specifiers in column format.  Pass them
        ;; to the resulting table, adding alignment field as the first
        ;; row.
        (push (mapcar (lambda (width) (when width (format "<%d>" width))) width-specs) table))
      ;; now insert the table into the buffer
      (goto-char ipos)
      (let ((content-lines (org-split-string (plist-get params :content) "\n"))
	    recalc)
	;; Insert affiliated keywords before the table.
	(when content-lines
	  (while (string-match-p "\\`[ \t]*#\\+" (car content-lines))
	    (insert (string-trim-left (pop content-lines)) "\n")))
	(save-excursion
	  ;; Insert table at point.
	  (insert
	   (mapconcat (lambda (row)
			(if (eq row 'hline) "|-|"
			  (format "|%s|" (mapconcat #'identity row "|"))))
		      table
		      "\n"))
	  ;; Insert TBLFM lines following table.
	  (let ((case-fold-search t))
	    (dolist (line content-lines)
	      (when (string-match-p "\\`[ \t]*#\\+TBLFM:" line)
		(insert "\n" (string-trim-left line))
		(unless recalc (setq recalc t))))))
	(when recalc (org-table-recalculate 'all t))
	(org-table-align)
        (when (seq-find #'identity width-specs)
          (org-table-shrink))))))