update packages and add valign

This commit is contained in:
2026-04-05 20:00:27 +02:00
parent b062fb98e3
commit 03fb00e374
640 changed files with 109768 additions and 39311 deletions

View File

@@ -1,6 +1,6 @@
;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2025 Free Software Foundation, Inc.
;; Copyright (C) 2004-2026 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, text
@@ -44,42 +44,32 @@
(require 'org-fold-core)
(declare-function calc-eval "calc" (str &optional separator &rest args))
(declare-function face-remap-remove-relative "face-remap" (cookie))
(declare-function face-remap-add-relative "face-remap" (face &rest specs))
(declare-function org-at-timestamp-p "org" (&optional extended))
(declare-function org-delete-backward-char "org" (N))
(declare-function org-mode "org" ())
(declare-function org-duration-p "org-duration" (duration &optional canonical))
(declare-function org-duration-p "org-duration" (duration))
(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical))
(declare-function org-element-at-point "org-element" (&optional pom cached-only))
(declare-function org-element-contents "org-element-ast" (node))
(declare-function org-element-extract "org-element-ast" (node))
(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-lineage "org-element-ast" (blob &optional types with-self))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated no-undefer))
(declare-function org-element-property "org-element-ast" (property node))
(declare-function org-element-end "org-element" (node))
(declare-function org-element-post-affiliated "org-element" (node))
(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-element-cache-reset "org-element" (&optional all no-persistence))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-export-create-backend "ox" (&rest rest) t)
(declare-function org-export-data-with-backend "ox" (data backend info))
(declare-function org-export-filter-apply-functions "ox" (filters value info))
(declare-function org-export-first-sibling-p "ox" (blob info))
(declare-function org-export-get-backend "ox" (name))
(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
(declare-function org-export-install-filters "ox" (info))
(declare-function org-export-table-has-special-column-p "ox" (table))
(declare-function org-export-table-row-is-special-p "ox" (table-row info))
(declare-function org-forward-paragraph "org" (&optional arg))
(declare-function org-id-find "org-id" (id &optional markerp))
(declare-function org-indent-line "org" ())
(declare-function org-load-modules-maybe "org" (&optional force))
(declare-function org-restart-font-lock "org" ())
(declare-function org-sort-remove-invisible "org" (s))
(declare-function org-time-stamp-format "org" (&optional long inactive))
(declare-function org-time-stamp-format "org" (&optional long inactive custom))
(declare-function org-time-string-to-absolute "org" (s &optional daynr prefer buffer pos))
(declare-function org-time-string-to-time "org" (s))
(declare-function org-timestamp-up-day "org" (&optional arg))
@@ -521,7 +511,7 @@ This may be useful when columns have been shrunk."
(define-minor-mode org-table-header-line-mode
"Display the first row of the table at point in the header line."
:lighter " TblHeader"
(unless (eq major-mode 'org-mode)
(unless (derived-mode-p 'org-mode)
(user-error "Cannot turn org table header mode outside org-mode buffers"))
(if org-table-header-line-mode
(add-hook 'post-command-hook #'org-table-header-set-header nil t)
@@ -929,8 +919,8 @@ nil When nil, the command tries to be smart and figure out the
(cond
((looking-at "^") (insert "| "))
((looking-at "[ \t]*$") (replace-match " |") (forward-line 1))
((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
(replace-match "\\1")
((looking-at "[ \t]*\"\\([^\"]*\\)\"")
(replace-match (replace-regexp-in-string "\n" " " (match-string 1)) t t)
(if (looking-at "\"") (insert "\"")))
((looking-at "[^,\n]+") (goto-char (match-end 0)))
((looking-at "[ \t]*,") (replace-match " | "))
@@ -1118,7 +1108,7 @@ Before doing so, re-align the table if necessary."
(when (looking-at "| ?")
(goto-char (match-end 0))))
(defun org-table-beginning-of-field (&optional n)
(defun org-table-beginning-of-field (n)
"Move to the beginning of the current table field.
If already at or before the beginning, move to the beginning of the
previous field.
@@ -1134,7 +1124,7 @@ With numeric argument N, move N-1 fields backward first."
(and (looking-at " ") (forward-char 1)))
(when (>= (point) pos) (org-table-beginning-of-field 2))))
(defun org-table-end-of-field (&optional n)
(defun org-table-end-of-field (n)
"Move to the end of the current table field.
If already at or after the end, move to the end of the next table field.
With numeric argument N, move N-1 fields forward first."
@@ -2539,8 +2529,7 @@ location of point."
;; replace fields with duration values if relevant
(if duration
(setq fields
(mapcar (lambda (x) (org-table-time-string-to-seconds x))
fields)))
(mapcar #'org-table-time-string-to-seconds fields)))
(if (eq numbers t)
(setq fields (mapcar
(lambda (x)
@@ -2967,139 +2956,141 @@ known that the table will be realigned a little later anyway."
beg end eqlcol eqlfield)
;; Insert constants in all formulas.
(when eqlist
(org-table-with-shrunk-columns
(org-table-save-field
;; Expand equations, then split the equation list between
;; column formulas and field formulas.
(dolist (eq eqlist)
(let* ((rhs (org-table-formula-substitute-names
(org-table-formula-handle-first/last-rc (cdr eq))))
(old-lhs (car eq))
(lhs
(org-table-formula-handle-first/last-rc
(cond
((string-match "\\`@-?I+" old-lhs)
(user-error "Can't assign to hline relative reference"))
((string-match "\\`\\$[<>]" old-lhs)
(let ((new (org-table-formula-handle-first/last-rc
old-lhs)))
(when (assoc new eqlist)
(user-error "\"%s=\" formula tries to overwrite \
(org-fold-core-ignore-modifications
(org-table-with-shrunk-columns
(org-table-save-field
;; Expand equations, then split the equation list between
;; column formulas and field formulas.
(dolist (eq eqlist)
(let* ((rhs (org-table-formula-substitute-names
(org-table-formula-handle-first/last-rc (cdr eq))))
(old-lhs (car eq))
(lhs
(org-table-formula-handle-first/last-rc
(cond
((string-match "\\`@-?I+" old-lhs)
(user-error "Can't assign to hline relative reference"))
((string-match "\\`\\$[<>]" old-lhs)
(let ((new (org-table-formula-handle-first/last-rc
old-lhs)))
(when (assoc new eqlist)
(user-error "\"%s=\" formula tries to overwrite \
existing formula for column %s"
old-lhs
new))
new))
(t old-lhs)))))
(if (string-match-p "\\`\\$[0-9]+\\'" lhs)
(push (cons lhs rhs) eqlcol)
(push (cons lhs rhs) eqlfield))))
(setq eqlcol (nreverse eqlcol))
;; Expand ranges in lhs of formulas
(setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))
;; Get the correct line range to process.
(if all
(progn
(setq end (copy-marker (org-table-end)))
(goto-char (setq beg org-table-current-begin-pos))
(cond
((re-search-forward org-table-calculate-mark-regexp end t)
;; This is a table with marked lines, compute selected
;; lines.
(setq line-re org-table-recalculate-regexp))
;; Move forward to the first non-header line.
((and (re-search-forward org-table-dataline-regexp end t)
(re-search-forward org-table-hline-regexp end t)
(re-search-forward org-table-dataline-regexp end t))
(setq beg (match-beginning 0)))
;; Just leave BEG at the start of the table.
(t nil)))
(setq beg (line-beginning-position)
end (copy-marker (line-beginning-position 2))))
(goto-char beg)
;; Mark named fields untouchable. Also check if several
;; field/range formulas try to set the same field.
(remove-text-properties beg end '(:org-untouchable t))
(let ((current-line (count-lines org-table-current-begin-pos
(line-beginning-position)))
seen-fields)
(dolist (eq eqlfield)
(let* ((name (car eq))
(location (assoc name org-table-named-field-locations))
(eq-line (or (nth 1 location)
(and (string-match "\\`@\\([0-9]+\\)" name)
(aref org-table-dlines
(string-to-number
(match-string 1 name))))))
(reference
(if location
;; Turn field coordinates associated to NAME
;; into an absolute reference.
(format "@%d$%d"
(org-table-line-to-dline eq-line)
(nth 2 location))
name)))
(when (member reference seen-fields)
(user-error "Several field/range formulas try to set %s"
reference))
(push reference seen-fields)
(when (or all (eq eq-line current-line))
(org-table-goto-field name)
(org-table-put-field-property :org-untouchable t)))))
;; Evaluate the column formulas, but skip fields covered by
;; field formulas.
(goto-char beg)
(while (re-search-forward line-re end t)
(unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
;; Unprotected line, recalculate.
(cl-incf cnt)
(when all
(setq log-last-time
(org-table-message-once-per-second
log-last-time
"Re-applying formulas to full table...(line %d)" cnt)))
(if (markerp org-last-recalc-line)
(move-marker org-last-recalc-line (line-beginning-position))
(setq org-last-recalc-line
(copy-marker (line-beginning-position))))
(dolist (entry eqlcol)
(goto-char org-last-recalc-line)
(org-table-goto-column
(string-to-number (substring (car entry) 1)) nil 'force)
(unless (get-text-property (point) :org-untouchable)
(org-table-eval-formula
nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
;; Evaluate the field formulas.
(dolist (eq eqlfield)
(let ((reference (car eq))
(formula (cdr eq)))
(setq log-last-time
(org-table-message-once-per-second
(and all log-last-time)
"Re-applying formula to field: %s" (car eq)))
(org-table-goto-field
reference
;; Possibly create a new column, as long as
;; `org-table-formula-create-columns' allows it.
(let ((column-count (progn (end-of-line)
(1- (org-table-current-column)))))
(lambda (column)
(when (> column 1000)
(user-error "Formula column target too large"))
(and (> column column-count)
(or (eq org-table-formula-create-columns t)
(and (eq org-table-formula-create-columns 'warn)
(progn
(org-display-warning
"Out-of-bounds formula added columns")
t))
(and (eq org-table-formula-create-columns 'prompt)
(yes-or-no-p
"Out-of-bounds formula. Add columns? "))
(user-error
"Missing columns in the table. Aborting"))))))
(org-table-eval-formula nil formula t t t t)))
;; Clean up marker.
(set-marker end nil)))
old-lhs
new))
new))
(t old-lhs)))))
(if (string-match-p "\\`\\$[0-9]+\\'" lhs)
(push (cons lhs rhs) eqlcol)
(push (cons lhs rhs) eqlfield))))
(setq eqlcol (nreverse eqlcol))
;; Expand ranges in lhs of formulas
(setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))
;; Get the correct line range to process.
(if all
(progn
(setq end (copy-marker (org-table-end)))
(goto-char (setq beg org-table-current-begin-pos))
(cond
((re-search-forward org-table-calculate-mark-regexp end t)
;; This is a table with marked lines, compute selected
;; lines.
(setq line-re org-table-recalculate-regexp))
;; Move forward to the first non-header line.
((and (re-search-forward org-table-dataline-regexp end t)
(re-search-forward org-table-hline-regexp end t)
(re-search-forward org-table-dataline-regexp end t))
(setq beg (match-beginning 0)))
;; Just leave BEG at the start of the table.
(t nil)))
(setq beg (line-beginning-position)
end (copy-marker (line-beginning-position 2))))
(org-combine-change-calls beg end
(goto-char beg)
;; Mark named fields untouchable. Also check if several
;; field/range formulas try to set the same field.
(remove-text-properties beg end '(:org-untouchable t))
(let ((current-line (count-lines org-table-current-begin-pos
(line-beginning-position)))
seen-fields)
(dolist (eq eqlfield)
(let* ((name (car eq))
(location (assoc name org-table-named-field-locations))
(eq-line (or (nth 1 location)
(and (string-match "\\`@\\([0-9]+\\)" name)
(aref org-table-dlines
(string-to-number
(match-string 1 name))))))
(reference
(if location
;; Turn field coordinates associated to NAME
;; into an absolute reference.
(format "@%d$%d"
(org-table-line-to-dline eq-line)
(nth 2 location))
name)))
(when (member reference seen-fields)
(user-error "Several field/range formulas try to set %s"
reference))
(push reference seen-fields)
(when (or all (eq eq-line current-line))
(org-table-goto-field name)
(org-table-put-field-property :org-untouchable t)))))
;; Evaluate the column formulas, but skip fields covered by
;; field formulas.
(goto-char beg)
(while (re-search-forward line-re end t)
(unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
;; Unprotected line, recalculate.
(cl-incf cnt)
(when all
(setq log-last-time
(org-table-message-once-per-second
log-last-time
"Re-applying formulas to full table...(line %d)" cnt)))
(if (markerp org-last-recalc-line)
(move-marker org-last-recalc-line (line-beginning-position))
(setq org-last-recalc-line
(copy-marker (line-beginning-position))))
(dolist (entry eqlcol)
(goto-char org-last-recalc-line)
(org-table-goto-column
(string-to-number (substring (car entry) 1)) nil 'force)
(unless (get-text-property (point) :org-untouchable)
(org-table-eval-formula
nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
;; Evaluate the field formulas.
(dolist (eq eqlfield)
(let ((reference (car eq))
(formula (cdr eq)))
(setq log-last-time
(org-table-message-once-per-second
(and all log-last-time)
"Re-applying formula to field: %s" (car eq)))
(org-table-goto-field
reference
;; Possibly create a new column, as long as
;; `org-table-formula-create-columns' allows it.
(let ((column-count (progn (end-of-line)
(1- (org-table-current-column)))))
(lambda (column)
(when (> column 1000)
(user-error "Formula column target too large"))
(and (> column column-count)
(or (eq org-table-formula-create-columns t)
(and (eq org-table-formula-create-columns 'warn)
(progn
(org-display-warning
"Out-of-bounds formula added columns")
t))
(and (eq org-table-formula-create-columns 'prompt)
(yes-or-no-p
"Out-of-bounds formula. Add columns? "))
(user-error
"Missing columns in the table. Aborting"))))))
(org-table-eval-formula nil formula t t t t)))
;; Clean up marker.
(set-marker end nil)))))
(unless noalign
(when org-table-may-need-update (org-table-align))
(when all
@@ -3143,7 +3134,7 @@ with the prefix ARG."
;; the way.
(org-table-recalculate t t)
(org-table-align))
t)))
t 'org)))
;;;###autoload
(defun org-table-iterate-buffer-tables ()
@@ -3157,7 +3148,9 @@ with the prefix ARG."
(catch 'exit
(while (> i 0)
(setq i (1- i))
(org-table-map-tables (lambda () (org-table-recalculate t t)) t)
(org-table-map-tables
(lambda () (org-table-recalculate t t))
t 'org)
(if (equal checksum (setq c1 (md5 (buffer-string))))
(progn
(org-table-map-tables #'org-table-align t)
@@ -3415,7 +3408,7 @@ Parameters get priority."
(when title
(unless (bobp) (insert "\n"))
(insert
(org-add-props (cdr title) nil 'face 'font-lock-comment-face))
(org-add-props (cdr title) nil 'face 'font-lock-comment-face))
(setq titles (remove title titles)))
(when (equal key (car entry)) (setq startline (org-current-line)))
(let ((s (concat
@@ -4296,12 +4289,16 @@ beginning and end position of the current table."
;;; Generic Tools
;;;###autoload
(defun org-table-map-tables (f &optional quietly)
"Apply function F to the start of all tables in the buffer."
(defun org-table-map-tables (f &optional quietly type)
"Apply function F to the start of all tables in the buffer.
When TYPE is non-nil, only consider Org tables of that type (symbol
`org' or symbol `table.el'."
(org-with-point-at 1
(while (re-search-forward org-table-line-regexp nil t)
(let ((table (org-element-lineage (org-element-at-point) 'table t)))
(when table
(when (and table
(or (not type)
(eq type (org-element-property :type table))))
(unless quietly
(message "Mapping tables: %d%%"
(floor (* 100.0 (point)) (buffer-size))))
@@ -4379,11 +4376,12 @@ extension of the given file name, and finally on the variable
(user-error "TABLE_EXPORT_FORMAT invalid")))))
;;;###autoload
(defun org-table--align-field (field width align)
(defun org-table--align-field (field width align &optional field-width)
"Format FIELD according to column WIDTH and alignment ALIGN.
FIELD is a string. WIDTH is a number. ALIGN is either \"c\",
\"l\" or\"r\"."
(let* ((spaces (- width (org-string-width field nil 'org-table)))
\"l\" or\"r\". If FIELD-WIDTH is non-nil, then it's used as
FIELD's width. Otherwise, it's calculated."
(let* ((spaces (- width (or field-width (org-string-width field nil 'org-table))))
(prefix (pcase align
("l" "")
("r" (make-string spaces ?\s))
@@ -4412,7 +4410,16 @@ FIELD is a string. WIDTH is a number. ALIGN is either \"c\",
(rows (remq 'hline table))
(widths nil)
(alignments nil)
(columns-number 1))
(columns-number 1)
(invisibility-spec (org-string-width-invisibility-spec))
(cell-width-cache (make-hash-table :test 'equal))
(get-or-compute-cell-width
(lambda (cell)
(or (gethash cell cell-width-cache)
(puthash
cell
(org-string-width cell nil 'org-table invisibility-spec)
cell-width-cache)))))
(if (null rows)
;; Table contains only horizontal rules. Compute the
;; number of columns anyway, and choose an arbitrary width
@@ -4432,7 +4439,7 @@ FIELD is a string. WIDTH is a number. ALIGN is either \"c\",
(non-empty 0))
(dolist (row rows)
(let ((cell (or (nth i row) "")))
(setq max-width (max max-width (org-string-width cell nil 'org-table)))
(setq max-width (max max-width (funcall get-or-compute-cell-width cell)))
(cond (fixed-align? nil)
((equal cell "") nil)
((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell)
@@ -4455,32 +4462,40 @@ FIELD is a string. WIDTH is a number. ALIGN is either \"c\",
(setq org-table-last-column-widths widths)
;; Build new table rows. Only replace rows that actually
;; changed.
(let ((rule (and (memq 'hline table)
(mapconcat (lambda (w) (make-string (+ 2 w) ?-))
widths
"+")))
(indent (progn (looking-at "[ \t]*|") (match-string 0))))
(dolist (row table)
(let ((previous (buffer-substring (point) (line-end-position)))
(new
(concat indent
(if (eq row 'hline) rule
(let* ((offset (- columns-number (length row)))
(fields (if (= 0 offset) row
;; Add missing fields.
(append row
(make-list offset "")))))
(mapconcat #'identity
(cl-mapcar #'org-table--align-field
fields
widths
alignments)
"|")))
"|")))
(if (equal new previous)
(forward-line)
(insert new "\n")
(delete-region (point) (line-beginning-position 2))))))
(org-fold-core-ignore-modifications
(org-combine-change-calls beg end
(let ((rule (and (memq 'hline table)
(mapconcat (lambda (w) (make-string (+ 2 w) ?-))
widths
"+")))
(indent (progn (looking-at "[ \t]*|") (match-string 0))))
(dolist (row table)
(let ((previous (buffer-substring (point) (line-end-position)))
(new
(concat indent
(if (eq row 'hline) rule
(let* ((offset (- columns-number (length row)))
(fields (if (= 0 offset) row
;; Add missing fields.
(append row
(make-list offset "")))))
(mapconcat #'identity
(cl-mapcar
(lambda (field width alignment)
(org-table--align-field
field
width
alignment
(funcall get-or-compute-cell-width field)))
fields
widths
alignments)
"|")))
"|")))
(if (equal new previous)
(forward-line)
(insert new "\n")
(delete-region (point) (line-beginning-position 2))))))))
(set-marker end nil)
(when org-table-overlay-coordinates (org-table-overlay-coordinates))
(setq org-table-may-need-update nil))))))
@@ -5657,6 +5672,42 @@ First element has index 0, or I0 if given."
(insert txt)
(goto-char pos)))
(defun orgtbl--skip (ast _ info)
"Extract first X table rows from AST.
X is taken from :skip property in INFO plist.
Return the modified AST."
(when-let* ((skip (plist-get info :skip)))
(unless (wholenump skip) (user-error "Wrong :skip value"))
(let ((n 0))
(org-element-map ast 'table-row
(lambda (row)
(if (>= n skip) t
(org-element-extract row)
(cl-incf n)
nil))
nil t)))
ast)
(defun orgtbl--skipcols (ast _ info)
"Extract first X table columns from AST.
X is taken from :skipcols property in INFO plist.
Special columns are always ignored.
Return the modified AST."
(when-let* ((skipcols (plist-get info :skipcols)))
(unless (consp skipcols) (user-error "Wrong :skipcols value"))
(org-element-map ast 'table
(lambda (table)
(let ((specialp (org-export-table-has-special-column-p table)))
(dolist (row (org-element-contents table))
(when (eq (org-element-property :type row) 'standard)
(let ((c 1))
(dolist (cell (nthcdr (if specialp 1 0)
(org-element-contents row)))
(when (memq c skipcols)
(org-element-extract cell))
(cl-incf c)))))))))
ast)
;;;###autoload
(defun orgtbl-to-generic (table params)
"Convert the `orgtbl-mode' TABLE to some other format.
@@ -5668,7 +5719,8 @@ a horizontal separator line, or a list of fields for that
line. PARAMS is a property list of parameters that can
influence the conversion.
Valid parameters are:
Valid parameters are all the export options understood by the export
backend and also:
:backend, :raw
@@ -5777,84 +5829,55 @@ This may be either a string or a function of two arguments:
;; regular backend has a transcoder for them. We
;; provide one so they are not ignored, but displayed
;; as-is instead.
(macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
data info)
(macro . (lambda (m c i) (org-element-macro-interpreter m nil)))
;; Only export the actual table. Do nothing with the
;; containing section regardless what backend think about
;; it. (It is somewhat like BODY-ONLY argument in
;; `org-export-as', but skips not only transcoding the
;; full document, but also section containing the table.
(section . (lambda (_ contents _) contents))))))
;; Store TABLE as Org syntax in DATA. Tolerate non-string cells.
;; Initialize communication channel in INFO.
(with-temp-buffer
(let ((standard-output (current-buffer)))
(dolist (e table)
(cond ((eq e 'hline) (princ "|--\n"))
((consp e)
(princ "| ") (dolist (c e) (princ c) (princ " |"))
(princ "\n")))))
(let ((org-inhibit-startup t)) (org-mode))
(org-fold-core-ignore-modifications
(let ((standard-output (current-buffer))
(org-element-use-cache nil))
(dolist (e table)
(cond ((eq e 'hline) (princ "|--\n"))
((consp e)
(princ "| ") (dolist (c e) (princ c) (princ " |"))
(princ "\n")))))
(org-element-cache-reset)
;; Add backend specific filters, but not user-defined ones. In
;; particular, make sure to call parse-tree filters on the
;; table.
(setq info
(let ((org-export-filters-alist nil))
(org-export-install-filters
(org-combine-plists
(org-export-get-environment backend nil params)
`(:back-end ,(org-export-get-backend backend))))))
(setq data
(org-export-filter-apply-functions
(plist-get info :filter-parse-tree)
(org-element-map (org-element-parse-buffer) 'table
#'identity nil t)
info))
(defvar org-export-before-processing-functions) ; ox.el
(defvar org-export-process-citations) ; ox.el
(defvar org-export-expand-links) ; ox.el
(defvar org-export-filter-parse-tree-functions) ; ox.el
(defvar org-export-filters-alist) ; ox.el
(defvar org-export-replace-macros) ; ox.el
(declare-function
org-export-as "ox"
(backend &optional subtreep visible-only body-only ext-plist))
;; We disable the usual pre-processing and post-processing,
;; i.e., hooks, Babel code evaluation, and macro expansion.
;; Only backend specific filters are retained.
;; We _do not_ disable `org-export-filter-parse-tree-functions'
;; (historically).
(let ((org-export-before-processing-functions nil)
(org-export-replace-macros nil)
(org-export-use-babel nil)
(org-export-before-parsing-functions nil)
(org-export-process-citations nil)
(org-export-expand-links nil)
(org-export-filter-parse-tree-functions
(append
'(orgtbl--skip orgtbl--skipcols)
org-export-filter-parse-tree-functions))
(org-export-filters-alist
'((:filter-parse-tree . org-export-filter-parse-tree-functions))))
(when (or (not backend) (plist-get params :raw)) (require 'ox-org))
(when (and backend (symbolp backend) (not (org-export-get-backend backend)))
(user-error "Unknown :backend value"))))
(when (or (not backend) (plist-get info :raw)) (require 'ox-org))
;; Handle :skip parameter.
(let ((skip (plist-get info :skip)))
(when skip
(unless (wholenump skip) (user-error "Wrong :skip value"))
(let ((n 0))
(org-element-map data 'table-row
(lambda (row)
(if (>= n skip) t
(org-element-extract row)
(cl-incf n)
nil))
nil t))))
;; Handle :skipcols parameter.
(let ((skipcols (plist-get info :skipcols)))
(when skipcols
(unless (consp skipcols) (user-error "Wrong :skipcols value"))
(org-element-map data 'table
(lambda (table)
(let ((specialp (org-export-table-has-special-column-p table)))
(dolist (row (org-element-contents table))
(when (eq (org-element-property :type row) 'standard)
(let ((c 1))
(dolist (cell (nthcdr (if specialp 1 0)
(org-element-contents row)))
(when (memq c skipcols)
(org-element-extract cell))
(cl-incf c))))))))))
;; Since we are going to export using a low-level mechanism,
;; ignore special column and special rows manually.
(let ((special? (org-export-table-has-special-column-p data))
ignore)
(org-element-map data (if special? '(table-cell table-row) 'table-row)
(lambda (datum)
(when (if (org-element-type-p datum 'table-row)
(org-export-table-row-is-special-p datum nil)
(org-export-first-sibling-p datum nil))
(push datum ignore))))
(setq info (plist-put info :ignore-list ignore)))
;; We use a low-level mechanism to export DATA so as to skip all
;; usual pre-processing and post-processing, i.e., hooks, Babel
;; code evaluation, include keywords and macro expansion. Only
;; backend specific filters are retained.
(let ((output (org-export-data-with-backend data custom-backend info)))
;; Remove final newline.
(if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
(user-error "Unknown :backend value: %S" backend))
(let ((output (org-export-as custom-backend nil nil 'body-only params)))
;; Remove final newline.
(if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))))
(defun org-table--generic-apply (value name &optional with-cons &rest args)
(cond ((null value) nil)