;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*-
|
|
;; Copyright (C) 2004-2018 Free Software Foundation, Inc.
|
|
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
;; Keywords: outlines, hypermedia, calendar, wp
|
;; Homepage: https://orgmode.org
|
;;
|
;; This file is part of GNU Emacs.
|
;;
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
;; it under the terms of the GNU General Public License as published by
|
;; the Free Software Foundation, either version 3 of the License, or
|
;; (at your option) any later version.
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;; GNU General Public License for more details.
|
|
;; You should have received a copy of the GNU General Public License
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;
|
;;; Commentary:
|
|
;; This file contains the table editor and spreadsheet for Org mode.
|
|
;; Watch out: Here we are talking about two different kind of tables.
|
;; Most of the code is for the tables created with the Org mode table editor.
|
;; Sometimes, we talk about tables created and edited with the table.el
|
;; Emacs package. We call the former org-type tables, and the latter
|
;; table.el-type tables.
|
|
;;; Code:
|
|
(require 'cl-lib)
|
(require 'org)
|
|
(declare-function org-element-at-point "org-element" ())
|
(declare-function org-element-contents "org-element" (element))
|
(declare-function org-element-extract-element "org-element" (element))
|
(declare-function org-element-interpret-data "org-element" (data))
|
(declare-function org-element-lineage "org-element"
|
(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))
|
(declare-function org-element-property "org-element" (property element))
|
(declare-function org-element-type "org-element" (element))
|
|
(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 calc-eval "calc" (str &optional separator &rest args))
|
|
(defvar constants-unit-system)
|
(defvar org-element-use-cache)
|
(defvar org-export-filters-alist)
|
(defvar org-table-follow-field-mode)
|
(defvar orgtbl-mode) ; defined below
|
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
|
(defvar sort-fold-case)
|
|
(defvar orgtbl-after-send-table-hook nil
|
"Hook for functions attaching to `C-c C-c', if the table is sent.
|
This can be used to add additional functionality after the table is sent
|
to the receiver position, otherwise, if table is not sent, the functions
|
are not run.")
|
|
(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ")
|
|
(defcustom orgtbl-optimized t
|
"Non-nil means use the optimized table editor version for `orgtbl-mode'.
|
|
In the optimized version, the table editor takes over all simple keys that
|
normally just insert a character. In tables, the characters are inserted
|
in a way to minimize disturbing the table structure (i.e. in overwrite mode
|
for empty fields). Outside tables, the correct binding of the keys is
|
restored.
|
|
Changing this variable requires a restart of Emacs to become
|
effective."
|
:group 'org-table
|
:type 'boolean)
|
|
(defcustom orgtbl-radio-table-templates
|
'((latex-mode "% BEGIN RECEIVE ORGTBL %n
|
% END RECEIVE ORGTBL %n
|
\\begin{comment}
|
#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0
|
| | |
|
\\end{comment}\n")
|
(texinfo-mode "@c BEGIN RECEIVE ORGTBL %n
|
@c END RECEIVE ORGTBL %n
|
@ignore
|
#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
|
| | |
|
@end ignore\n")
|
(html-mode "<!-- BEGIN RECEIVE ORGTBL %n -->
|
<!-- END RECEIVE ORGTBL %n -->
|
<!--
|
#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
|
| | |
|
-->\n")
|
(org-mode "#+ BEGIN RECEIVE ORGTBL %n
|
#+ END RECEIVE ORGTBL %n
|
|
#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0
|
| | |
|
"))
|
"Templates for radio tables in different major modes.
|
Each template must define lines that will be treated as a comment and that
|
must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\"
|
lines where \"%n\" will be replaced with the name of the table during
|
insertion of the template. The transformed table will later be inserted
|
between these lines.
|
|
The template should also contain a minimal table in a multiline comment.
|
If multiline comments are not possible in the buffer language,
|
you can pack it into a string that will not be used when the code
|
is compiled or executed. Above the table will you need a line with
|
the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to
|
convert the table into a data structure useful in the
|
language of the buffer. Check the manual for the section on
|
\"Translator functions\", and more generally check out
|
the Info node `(org)Tables in arbitrary syntax'.
|
|
All occurrences of %n in a template will be replaced with the name of the
|
table, obtained by prompting the user."
|
:group 'org-table
|
:type '(repeat
|
(list (symbol :tag "Major mode")
|
(string :tag "Format"))))
|
|
(defgroup org-table-settings nil
|
"Settings for tables in Org mode."
|
:tag "Org Table Settings"
|
:group 'org-table)
|
|
(defcustom org-table-default-size "5x2"
|
"The default size for newly created tables, Columns x Rows."
|
:group 'org-table-settings
|
:type 'string)
|
|
(defcustom org-table-number-regexp
|
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$"
|
"Regular expression for recognizing numbers in table columns.
|
If a table column contains mostly numbers, it will be aligned to the
|
right. If not, it will be aligned to the left.
|
|
The default value of this option is a regular expression which allows
|
anything which looks remotely like a number as used in scientific
|
context. For example, all of the following will be considered a
|
number:
|
12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5
|
|
Other options offered by the customize interface are more restrictive."
|
:group 'org-table-settings
|
:type '(choice
|
(const :tag "Positive Integers"
|
"^[0-9]+$")
|
(const :tag "Integers"
|
"^[-+]?[0-9]+$")
|
(const :tag "Floating Point Numbers"
|
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$")
|
(const :tag "Floating Point Number or Integer"
|
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$")
|
(const :tag "Exponential, Floating point, Integer"
|
"^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
|
(const :tag "Very General Number-Like, including hex and Calc radix"
|
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
|
(const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark"
|
"^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
|
(string :tag "Regexp:")))
|
|
(defcustom org-table-number-fraction 0.5
|
"Fraction of numbers in a column required to make the column align right.
|
In a column all non-white fields are considered. If at least
|
this fraction of fields is matched by `org-table-number-regexp',
|
alignment to the right border applies."
|
:group 'org-table-settings
|
:type 'number)
|
|
(defgroup org-table-editing nil
|
"Behavior of tables during editing in Org mode."
|
:tag "Org Table Editing"
|
:group 'org-table)
|
|
(defcustom org-table-automatic-realign t
|
"Non-nil means automatically re-align table when pressing TAB or RETURN.
|
When nil, aligning is only done with `\\[org-table-align]', or after column
|
removal/insertion."
|
:group 'org-table-editing
|
:type 'boolean)
|
|
(defcustom org-table-auto-blank-field t
|
"Non-nil means automatically blank table field when starting to type into it.
|
This only happens when typing immediately after a field motion
|
command (TAB, S-TAB or RET)."
|
:group 'org-table-editing
|
:type 'boolean)
|
|
(defcustom org-table-exit-follow-field-mode-when-leaving-table t
|
"Non-nil means automatically exit the follow mode.
|
When nil, the follow mode will stay on and be active in any table
|
the cursor enters. Since the table follow filed mode messes with the
|
window configuration, it is not recommended to set this variable to nil,
|
except maybe locally in a special file that has mostly tables with long
|
fields."
|
:group 'org-table
|
:version "24.1"
|
:type 'boolean)
|
|
(defcustom org-table-fix-formulas-confirm nil
|
"Whether the user should confirm when Org fixes formulas."
|
:group 'org-table-editing
|
:version "24.1"
|
:type '(choice
|
(const :tag "with yes-or-no" yes-or-no-p)
|
(const :tag "with y-or-n" y-or-n-p)
|
(const :tag "no confirmation" nil)))
|
(put 'org-table-fix-formulas-confirm
|
'safe-local-variable
|
#'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
|
|
(defcustom org-table-tab-jumps-over-hlines t
|
"Non-nil means tab in the last column of a table with jump over a hline.
|
If a horizontal separator line is following the current line,
|
`org-table-next-field' can either create a new row before that line, or jump
|
over the line. When this option is nil, a new line will be created before
|
this line."
|
:group 'org-table-editing
|
:type 'boolean)
|
|
(defgroup org-table-calculation nil
|
"Options concerning tables in Org mode."
|
:tag "Org Table Calculation"
|
:group 'org-table)
|
|
(defcustom org-table-use-standard-references 'from
|
"Non-nil means using table references like B3 instead of @3$2.
|
Possible values are:
|
nil never use them
|
from accept as input, do not present for editing
|
t accept as input and present for editing"
|
:group 'org-table-calculation
|
:type '(choice
|
(const :tag "Never, don't even check user input for them" nil)
|
(const :tag "Always, both as user input, and when editing" t)
|
(const :tag "Convert user input, don't offer during editing" from)))
|
|
(defcustom org-table-copy-increment t
|
"Non-nil means increment when copying current field with \
|
`\\[org-table-copy-down]'."
|
:group 'org-table-calculation
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:type '(choice
|
(const :tag "Use the difference between the current and the above fields" t)
|
(integer :tag "Use a number" 1)
|
(const :tag "Don't increment the value when copying a field" nil)))
|
|
(defcustom org-calc-default-modes
|
'(calc-internal-prec 12
|
calc-float-format (float 8)
|
calc-angle-mode deg
|
calc-prefer-frac nil
|
calc-symbolic-mode nil
|
calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm))
|
calc-display-working-message t
|
)
|
"List with Calc mode settings for use in `calc-eval' for table formulas.
|
The list must contain alternating symbols (Calc modes variables and values).
|
Don't remove any of the default settings, just change the values. Org mode
|
relies on the variables to be present in the list."
|
:group 'org-table-calculation
|
:type 'plist)
|
|
(defcustom org-table-duration-custom-format 'hours
|
"Format for the output of calc computations like $1+$2;t.
|
The default value is `hours', and will output the results as a
|
number of hours. Other allowed values are `seconds', `minutes' and
|
`days', and the output will be a fraction of seconds, minutes or
|
days. `hh:mm' selects to use hours and minutes, ignoring seconds.
|
The `U' flag in a table formula will select this specific format for
|
a single formula."
|
:group 'org-table-calculation
|
:version "24.1"
|
:type '(choice (symbol :tag "Seconds" 'seconds)
|
(symbol :tag "Minutes" 'minutes)
|
(symbol :tag "Hours " 'hours)
|
(symbol :tag "Days " 'days)
|
(symbol :tag "HH:MM " 'hh:mm)))
|
|
(defcustom org-table-duration-hour-zero-padding t
|
"Non-nil means hours in table duration computations should be zero-padded.
|
So this is about 08:32:34 versus 8:33:34."
|
:group 'org-table-calculation
|
:version "26.1"
|
:package-version '(Org . "9.1")
|
:type 'boolean
|
:safe #'booleanp)
|
|
(defcustom org-table-formula-field-format "%s"
|
"Format for fields which contain the result of a formula.
|
For example, using \"~%s~\" will display the result within tilde
|
characters. Beware that modifying the display can prevent the
|
field from being used in another formula."
|
:group 'org-table-settings
|
:version "24.1"
|
:type 'string)
|
|
(defcustom org-table-formula-evaluate-inline t
|
"Non-nil means TAB and RET evaluate a formula in current table field.
|
If the current field starts with an equal sign, it is assumed to be a formula
|
which should be evaluated as described in the manual and in the documentation
|
string of the command `org-table-eval-formula'. This feature requires the
|
Emacs calc package.
|
When this variable is nil, formula calculation is only available through
|
the command `\\[org-table-eval-formula]'."
|
:group 'org-table-calculation
|
:type 'boolean)
|
|
(defcustom org-table-formula-use-constants t
|
"Non-nil means interpret constants in formulas in tables.
|
A constant looks like `$c' or `$Grav' and will be replaced before evaluation
|
by the value given in `org-table-formula-constants', or by a value obtained
|
from the `constants.el' package."
|
:group 'org-table-calculation
|
:type 'boolean)
|
|
(defcustom org-table-formula-constants nil
|
"Alist with constant names and values, for use in table formulas.
|
The car of each element is a name of a constant, without the `$' before it.
|
The cdr is the value as a string. For example, if you'd like to use the
|
speed of light in a formula, you would configure
|
|
(setq org-table-formula-constants \\='((\"c\" . \"299792458.\")))
|
|
and then use it in an equation like `$1*$c'.
|
|
Constants can also be defined on a per-file basis using a line like
|
|
#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6"
|
:group 'org-table-calculation
|
:type '(repeat
|
(cons (string :tag "name")
|
(string :tag "value"))))
|
|
(defcustom org-table-allow-automatic-line-recalculation t
|
"Non-nil means lines marked with |#| or |*| will be recomputed automatically.
|
\\<org-mode-map>\
|
Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \
|
are pressed in the line."
|
:group 'org-table-calculation
|
:type 'boolean)
|
|
(defcustom org-table-relative-ref-may-cross-hline t
|
"Non-nil means relative formula references may cross hlines.
|
Here are the allowed values:
|
|
nil Relative references may not cross hlines. They will reference the
|
field next to the hline instead. Coming from below, the reference
|
will be to the field below the hline. Coming from above, it will be
|
to the field above.
|
t Relative references may cross hlines.
|
error An attempt to cross a hline will throw an error.
|
|
It is probably good to never set this variable to nil, for the sake of
|
portability of tables."
|
:group 'org-table-calculation
|
:type '(choice
|
(const :tag "Allow to cross" t)
|
(const :tag "Stick to hline" nil)
|
(const :tag "Error on attempt to cross" error)))
|
|
(defcustom org-table-formula-create-columns nil
|
"Non-nil means evaluation of formula can add new columns.
|
When non-nil, evaluating an out-of-bounds field can insert as
|
many columns as needed. When set to `warn', issue a warning when
|
doing so. When set to `prompt', ask user before creating a new
|
column. Otherwise, throw an error."
|
:group 'org-table-calculation
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:type '(choice
|
(const :tag "Out-of-bounds field generates an error (default)" nil)
|
(const :tag "Out-of-bounds field silently adds columns as needed" t)
|
(const :tag "Out-of-bounds field adds columns, but issues a warning" warn)
|
(const :tag "Prompt user when setting an out-of-bounds field" prompt)))
|
|
(defgroup org-table-import-export nil
|
"Options concerning table import and export in Org mode."
|
:tag "Org Table Import Export"
|
:group 'org-table)
|
|
(defcustom org-table-export-default-format "orgtbl-to-tsv"
|
"Default export parameters for `org-table-export'.
|
These can be overridden for a specific table by setting the
|
TABLE_EXPORT_FORMAT property. See the manual section on orgtbl
|
radio tables for the different export transformations and
|
available parameters."
|
:group 'org-table-import-export
|
:type 'string)
|
|
(defcustom org-table-convert-region-max-lines 999
|
"Max lines that `org-table-convert-region' will attempt to process.
|
|
The function can be slow on larger regions; this safety feature
|
prevents it from hanging emacs."
|
:group 'org-table-import-export
|
:type 'integer
|
:version "26.1"
|
:package-version '(Org . "8.3"))
|
|
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
|
"Regexp matching a line marked for automatic recalculation.")
|
|
(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
|
"Regexp matching a line marked for recalculation.")
|
|
(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
|
"Regexp matching a line marked for calculation.")
|
|
(defconst org-table-border-regexp "^[ \t]*[^| \t]"
|
"Regexp matching any line outside an Org table.")
|
|
(defvar org-table-last-highlighted-reference nil)
|
|
(defvar org-table-formula-history nil)
|
|
(defvar org-table-column-names nil
|
"Alist with column names, derived from the `!' line.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-column-name-regexp nil
|
"Regular expression matching the current column names.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-local-parameters nil
|
"Alist with parameter names, derived from the `$' line.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-named-field-locations nil
|
"Alist with locations of named fields.
|
Associations follow the pattern (NAME LINE COLUMN) where
|
NAME is the name of the field as a string,
|
LINE is the number of lines from the beginning of the table,
|
COLUMN is the column of the field, as an integer.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-current-line-types nil
|
"Table row types in current table.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-current-begin-pos nil
|
"Current table begin position, as a marker.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-current-ncol nil
|
"Number of columns in current table.
|
This variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-dlines nil
|
"Vector of data line line numbers in the current table.
|
Line numbers are counted from the beginning of the table. This
|
variable is initialized with `org-table-analyze'.")
|
|
(defvar org-table-hlines nil
|
"Vector of hline line numbers in the current table.
|
Line numbers are counted from the beginning of the table. This
|
variable is initialized with `org-table-analyze'.")
|
|
(defconst org-table-range-regexp
|
"@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
|
;; 1 2 3 4 5
|
"Regular expression for matching ranges in formulas.")
|
|
(defconst org-table-range-regexp2
|
(concat
|
"\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)"
|
"\\.\\."
|
"\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
|
"Match a range for reference display.")
|
|
(defconst org-table-translate-regexp
|
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
|
"Match a reference that needs translation, for reference display.")
|
|
(defmacro org-table-save-field (&rest body)
|
"Save current field; execute BODY; restore field.
|
Field is restored even in case of abnormal exit."
|
(declare (debug (body)))
|
(org-with-gensyms (line column)
|
`(let ((,line (copy-marker (line-beginning-position)))
|
(,column (org-table-current-column)))
|
(unwind-protect
|
(progn ,@body)
|
(goto-char ,line)
|
(org-table-goto-column ,column)
|
(set-marker ,line nil)))))
|
|
;;;###autoload
|
(defun org-table-create-with-table.el ()
|
"Use the table.el package to insert a new table.
|
If there is already a table at point, convert between Org tables
|
and table.el tables."
|
(interactive)
|
(require 'table)
|
(cond
|
((org-at-table.el-p)
|
(if (y-or-n-p "Convert table to Org table? ")
|
(org-table-convert)))
|
((org-at-table-p)
|
(when (y-or-n-p "Convert table to table.el table? ")
|
(org-table-align)
|
(org-table-convert)))
|
(t (call-interactively 'table-insert))))
|
|
;;;###autoload
|
(defun org-table-create-or-convert-from-region (arg)
|
"Convert region to table, or create an empty table.
|
If there is an active region, convert it to a table, using the function
|
`org-table-convert-region'. See the documentation of that function
|
to learn how the prefix argument is interpreted to determine the field
|
separator.
|
If there is no such region, create an empty table with `org-table-create'."
|
(interactive "P")
|
(if (org-region-active-p)
|
(org-table-convert-region (region-beginning) (region-end) arg)
|
(org-table-create arg)))
|
|
;;;###autoload
|
(defun org-table-create (&optional size)
|
"Query for a size and insert a table skeleton.
|
SIZE is a string Columns x Rows like for example \"3x2\"."
|
(interactive "P")
|
(unless size
|
(setq size (read-string
|
(concat "Table size Columns x Rows [e.g. "
|
org-table-default-size "]: ")
|
"" nil org-table-default-size)))
|
|
(let* ((pos (point))
|
(indent (make-string (current-column) ?\ ))
|
(split (org-split-string size " *x *"))
|
(rows (string-to-number (nth 1 split)))
|
(columns (string-to-number (car split)))
|
(line (concat (apply 'concat indent "|" (make-list columns " |"))
|
"\n")))
|
(if (string-match "^[ \t]*$" (buffer-substring-no-properties
|
(point-at-bol) (point)))
|
(beginning-of-line 1)
|
(newline))
|
;; (mapcar (lambda (x) (insert line)) (make-list rows t))
|
(dotimes (_ rows) (insert line))
|
(goto-char pos)
|
(if (> rows 1)
|
;; Insert a hline after the first row.
|
(progn
|
(end-of-line 1)
|
(insert "\n|-")
|
(goto-char pos)))
|
(org-table-align)))
|
|
;;;###autoload
|
(defun org-table-convert-region (beg0 end0 &optional separator)
|
"Convert region to a table.
|
|
The region goes from BEG0 to END0, but these borders will be moved
|
slightly, to make sure a beginning of line in the first line is included.
|
|
SEPARATOR specifies the field separator in the lines. It can have the
|
following values:
|
|
(4) Use the comma as a field separator
|
(16) Use a TAB as field separator
|
(64) Prompt for a regular expression as field separator
|
integer When a number, use that many spaces, or a TAB, as field separator
|
regexp When a regular expression, use it to match the separator
|
nil When nil, the command tries to be smart and figure out the
|
separator in the following way:
|
- when each line contains a TAB, assume TAB-separated material
|
- when each line contains a comma, assume CSV material
|
- else, assume one or more SPACE characters as separator."
|
(interactive "r\nP")
|
(let* ((beg (min beg0 end0))
|
(end (max beg0 end0))
|
re)
|
(if (> (count-lines beg end) org-table-convert-region-max-lines)
|
(user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting"
|
org-table-convert-region-max-lines)
|
(if (equal separator '(64))
|
(setq separator (read-regexp "Regexp for field separator")))
|
(goto-char beg)
|
(beginning-of-line 1)
|
(setq beg (point-marker))
|
(goto-char end)
|
(if (bolp) (backward-char 1) (end-of-line 1))
|
(setq end (point-marker))
|
;; Get the right field separator
|
(unless separator
|
(goto-char beg)
|
(setq separator
|
(cond
|
((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
|
((not (re-search-forward "^[^\n,]+$" end t)) '(4))
|
(t 1))))
|
(goto-char beg)
|
(if (equal separator '(4))
|
(while (< (point) end)
|
;; parse the csv stuff
|
(cond
|
((looking-at "^") (insert "| "))
|
((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
|
((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
|
(replace-match "\\1")
|
(if (looking-at "\"") (insert "\"")))
|
((looking-at "[^,\n]+") (goto-char (match-end 0)))
|
((looking-at "[ \t]*,") (replace-match " | "))
|
(t (beginning-of-line 2))))
|
(setq re (cond
|
((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
|
((equal separator '(16)) "^\\|\t")
|
((integerp separator)
|
(if (< separator 1)
|
(user-error "Number of spaces in separator must be >= 1")
|
(format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
|
((stringp separator)
|
(format "^ *\\|%s" separator))
|
(t (error "This should not happen"))))
|
(while (re-search-forward re end t)
|
(replace-match "| " t t)))
|
(goto-char beg)
|
(org-table-align))))
|
|
;;;###autoload
|
(defun org-table-import (file separator)
|
"Import FILE as a table.
|
|
The command tries to be smart and figure out the separator in the
|
following way:
|
|
- when each line contains a TAB, assume TAB-separated material
|
- when each line contains a comma, assume CSV material
|
- else, assume one or more SPACE characters as separator.
|
|
When non-nil, SEPARATOR specifies the field separator in the
|
lines. It can have the following values:
|
|
(4) Use the comma as a field separator
|
(16) Use a TAB as field separator
|
(64) Prompt for a regular expression as field separator
|
integer When a number, use that many spaces, or a TAB, as field separator
|
regexp When a regular expression, use it to match the separator."
|
(interactive "f\nP")
|
(unless (bolp) (insert "\n"))
|
(let ((beg (point))
|
(pm (point-max)))
|
(insert-file-contents file)
|
(org-table-convert-region beg (+ (point) (- (point-max) pm)) separator)))
|
|
|
;;;###autoload
|
(defun org-table-export (&optional file format)
|
"Export table to a file, with configurable format.
|
Such a file can be imported into usual spreadsheet programs.
|
|
FILE can be the output file name. If not given, it will be taken
|
from a TABLE_EXPORT_FILE property in the current entry or higher
|
up in the hierarchy, or the user will be prompted for a file
|
name. FORMAT can be an export format, of the same kind as it
|
used when `orgtbl-mode' sends a table in a different format.
|
|
The command suggests a format depending on TABLE_EXPORT_FORMAT,
|
whether it is set locally or up in the hierarchy, then on the
|
extension of the given file name, and finally on the variable
|
`org-table-export-default-format'."
|
(interactive)
|
(unless (org-at-table-p) (user-error "No table at point"))
|
(org-table-align) ; Make sure we have everything we need.
|
(let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t))))
|
(unless file
|
(setq file (read-file-name "Export table to: "))
|
(unless (or (not (file-exists-p file))
|
(y-or-n-p (format "Overwrite file %s? " file)))
|
(user-error "File not written")))
|
(when (file-directory-p file)
|
(user-error "This is a directory path, not a file"))
|
(when (and (buffer-file-name (buffer-base-buffer))
|
(file-equal-p
|
(file-truename file)
|
(file-truename (buffer-file-name (buffer-base-buffer)))))
|
(user-error "Please specify a file name that is different from current"))
|
(let ((fileext (concat (file-name-extension file) "$"))
|
(format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t))))
|
(unless format
|
(let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex"
|
"orgtbl-to-html" "orgtbl-to-generic"
|
"orgtbl-to-texinfo" "orgtbl-to-orgtbl"
|
"orgtbl-to-unicode"))
|
(deffmt-readable
|
(replace-regexp-in-string
|
"\t" "\\t"
|
(replace-regexp-in-string
|
"\n" "\\n"
|
(or (car (delq nil
|
(mapcar
|
(lambda (f)
|
(and (string-match-p fileext f) f))
|
formats)))
|
org-table-export-default-format)
|
t t) t t)))
|
(setq format
|
(org-completing-read
|
"Format: " formats nil nil deffmt-readable))))
|
(if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
|
(let ((transform (intern (match-string 1 format)))
|
(params (and (match-end 2)
|
(read (concat "(" (match-string 2 format) ")"))))
|
(table (org-table-to-lisp
|
(buffer-substring-no-properties
|
(org-table-begin) (org-table-end)))))
|
(unless (fboundp transform)
|
(user-error "No such transformation function %s" transform))
|
(let (buf)
|
(with-current-buffer (find-file-noselect file)
|
(setq buf (current-buffer))
|
(erase-buffer)
|
(fundamental-mode)
|
(insert (funcall transform table params) "\n")
|
(save-buffer))
|
(kill-buffer buf))
|
(message "Export done."))
|
(user-error "TABLE_EXPORT_FORMAT invalid")))))
|
|
(defvar org-table-aligned-begin-marker (make-marker)
|
"Marker at the beginning of the table last aligned.
|
Used to check if cursor still is in that table, to minimize realignment.")
|
(defvar org-table-aligned-end-marker (make-marker)
|
"Marker at the end of the table last aligned.
|
Used to check if cursor still is in that table, to minimize realignment.")
|
(defvar org-table-last-alignment nil
|
"List of flags for flushright alignment, from the last re-alignment.
|
This is being used to correctly align a single field after TAB or RET.")
|
(defvar org-table-last-column-widths nil
|
"List of max width of fields in each column.
|
This is being used to correctly align a single field after TAB or RET.")
|
(defvar-local org-table-formula-debug nil
|
"Non-nil means debug table formulas.
|
When nil, simply write \"#ERROR\" in corrupted fields.")
|
(defvar-local org-table-overlay-coordinates nil
|
"Overlay coordinates after each align of a table.")
|
|
(defvar org-last-recalc-line nil)
|
(defvar org-table-do-narrow t) ; for dynamic scoping
|
(defconst org-narrow-column-arrow "=>"
|
"Used as display property in narrowed table columns.")
|
|
;;;###autoload
|
(defun org-table-align ()
|
"Align the table at point by aligning all vertical bars."
|
(interactive)
|
(let* ((beg (org-table-begin))
|
(end (copy-marker (org-table-end))))
|
(org-table-save-field
|
;; Make sure invisible characters in the table are at the right
|
;; place since column widths take them into account.
|
(font-lock-fontify-region beg end)
|
(move-marker org-table-aligned-begin-marker beg)
|
(move-marker org-table-aligned-end-marker end)
|
(goto-char beg)
|
(let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
|
;; Table's rows. Separators are replaced by nil. Trailing
|
;; spaces are also removed.
|
(lines (mapcar (lambda (l)
|
(and (not (string-match-p "\\`[ \t]*|-" l))
|
(let ((l (org-trim l)))
|
(remove-text-properties
|
0 (length l) '(display t org-cwidth t) l)
|
l)))
|
(org-split-string (buffer-substring beg end) "\n")))
|
;; Get the data fields by splitting the lines.
|
(fields (mapcar (lambda (l) (org-split-string l " *| *"))
|
(remq nil lines)))
|
;; Compute number of fields in the longest line. If the
|
;; table contains no field, create a default table.
|
(maxfields (if fields (apply #'max (mapcar #'length fields))
|
(kill-region beg end)
|
(org-table-create org-table-default-size)
|
(user-error "Empty table - created default table")))
|
;; A list of empty strings to fill any short rows on output.
|
(emptycells (make-list maxfields ""))
|
lengths typenums)
|
;; Check for special formatting.
|
(dotimes (i maxfields)
|
(let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
|
fmax falign)
|
;; Look for an explicit width or alignment.
|
(when (save-excursion
|
(or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
|
(and org-table-do-narrow
|
(re-search-forward
|
"| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
|
(catch :exit
|
(dolist (cell column)
|
(when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
|
(when (match-end 1) (setq falign (match-string 1 cell)))
|
(when (and org-table-do-narrow (match-end 2))
|
(setq fmax (string-to-number (match-string 2 cell))))
|
(when (or falign fmax) (throw :exit nil)))))
|
;; Find fields that are wider than FMAX, and shorten them.
|
(when fmax
|
(dolist (x column)
|
(when (> (org-string-width x) fmax)
|
(org-add-props x nil
|
'help-echo
|
(concat
|
"Clipped table field, use `\\[org-table-edit-field]' to \
|
edit. Full value is:\n"
|
(substring-no-properties x)))
|
(let ((l (length x))
|
(f1 (min fmax
|
(or (string-match org-bracket-link-regexp x)
|
fmax)))
|
(f2 1))
|
(unless (> f1 1)
|
(user-error
|
"Cannot narrow field starting with wide link \"%s\""
|
(match-string 0 x)))
|
(if (= (org-string-width x) l) (setq f2 f1)
|
(setq f2 1)
|
(while (< (org-string-width (substring x 0 f2)) f1)
|
(cl-incf f2)))
|
(add-text-properties f2 l (list 'org-cwidth t) x)
|
(add-text-properties
|
(if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
|
(- f2 2))
|
f2
|
(list 'display org-narrow-column-arrow)
|
x))))))
|
;; Get the maximum width for each column
|
(push (or fmax (apply #'max 1 (mapcar #'org-string-width column)))
|
lengths)
|
;; Get the fraction of numbers among non-empty cells to
|
;; decide about alignment of the column.
|
(if falign (push (equal (downcase falign) "r") typenums)
|
(let ((cnt 0)
|
(frac 0.0))
|
(dolist (x column)
|
(unless (equal x "")
|
(setq frac
|
(/ (+ (* frac cnt)
|
(if (string-match-p org-table-number-regexp x)
|
1
|
0))
|
(cl-incf cnt)))))
|
(push (>= frac org-table-number-fraction) typenums)))))
|
(setq lengths (nreverse lengths))
|
(setq typenums (nreverse typenums))
|
;; Store alignment of this table, for later editing of single
|
;; fields.
|
(setq org-table-last-alignment typenums)
|
(setq org-table-last-column-widths lengths)
|
;; With invisible characters, `format' does not get the field
|
;; width right So we need to make these fields wide by hand.
|
;; Invisible characters may be introduced by fontified links,
|
;; emphasis, macros or sub/superscripts.
|
(when (or (text-property-any beg end 'invisible 'org-link)
|
(text-property-any beg end 'invisible t))
|
(dotimes (i maxfields)
|
(let ((len (nth i lengths)))
|
(dotimes (j (length fields))
|
(let* ((c (nthcdr i (nth j fields)))
|
(cell (car c)))
|
(when (and
|
(stringp cell)
|
(let ((l (length cell)))
|
(or (text-property-any 0 l 'invisible 'org-link cell)
|
(text-property-any beg end 'invisible t)))
|
(< (org-string-width cell) len))
|
(let ((s (make-string (- len (org-string-width cell)) ?\s)))
|
(setcar c (if (nth i typenums) (concat s cell)
|
(concat cell s))))))))))
|
|
;; Compute the formats needed for output of the table.
|
(let ((hfmt (concat indent "|"))
|
(rfmt (concat indent "|"))
|
(rfmt1 " %%%s%ds |")
|
(hfmt1 "-%s-+"))
|
(dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
|
(let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
|
(setq rfmt (concat rfmt (format rfmt1 ty l)))
|
(setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
|
;; Replace modified lines only. Check not only contents, but
|
;; also columns' width.
|
(dolist (l lines)
|
(let ((line
|
(if l (apply #'format rfmt (append (pop fields) emptycells))
|
hfmt))
|
(previous (buffer-substring (point) (line-end-position))))
|
(if (and (equal previous line)
|
(let ((a 0)
|
(b 0))
|
(while (and (progn
|
(setq a (next-single-property-change
|
a 'org-cwidth previous))
|
(setq b (next-single-property-change
|
b 'org-cwidth line)))
|
(eq a b)))
|
(eq a b)))
|
(forward-line)
|
(insert line "\n")
|
(delete-region (point) (line-beginning-position 2))))))
|
(when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
|
(goto-char org-table-aligned-begin-marker)
|
(while (org-hide-wide-columns org-table-aligned-end-marker)))
|
(set-marker end nil)
|
(when org-table-overlay-coordinates (org-table-overlay-coordinates))
|
(setq org-table-may-need-update nil)))))
|
|
;;;###autoload
|
(defun org-table-begin (&optional table-type)
|
"Find the beginning of the table and return its position.
|
With a non-nil optional argument TABLE-TYPE, return the beginning
|
of a table.el-type table. This function assumes point is on
|
a table."
|
(cond (table-type
|
(org-element-property :post-affiliated (org-element-at-point)))
|
((save-excursion
|
(and (re-search-backward org-table-border-regexp nil t)
|
(line-beginning-position 2))))
|
(t (point-min))))
|
|
;;;###autoload
|
(defun org-table-end (&optional table-type)
|
"Find the end of the table and return its position.
|
With a non-nil optional argument TABLE-TYPE, return the end of
|
a table.el-type table. This function assumes point is on
|
a table."
|
(save-excursion
|
(cond (table-type
|
(goto-char (org-element-property :end (org-element-at-point)))
|
(skip-chars-backward " \t\n")
|
(line-beginning-position 2))
|
((re-search-forward org-table-border-regexp nil t)
|
(match-beginning 0))
|
;; When the line right after the table is the last line in
|
;; the buffer with trailing spaces but no final newline
|
;; character, be sure to catch the correct ending at its
|
;; beginning. In any other case, ending is expected to be
|
;; at point max.
|
(t (goto-char (point-max))
|
(skip-chars-backward " \t")
|
(if (bolp) (point) (line-end-position))))))
|
|
;;;###autoload
|
(defun org-table-justify-field-maybe (&optional new)
|
"Justify the current field, text to left, number to right.
|
Optional argument NEW may specify text to replace the current field content."
|
(cond
|
((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
|
((org-at-table-hline-p))
|
((and (not new)
|
(or (not (eq (marker-buffer org-table-aligned-begin-marker)
|
(current-buffer)))
|
(< (point) org-table-aligned-begin-marker)
|
(>= (point) org-table-aligned-end-marker)))
|
;; This is not the same table, force a full re-align.
|
(setq org-table-may-need-update t))
|
(t
|
;; Realign the current field, based on previous full realign.
|
(let ((pos (point))
|
(col (org-table-current-column)))
|
(when (> col 0)
|
(skip-chars-backward "^|")
|
(if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)"))
|
(setq org-table-may-need-update t)
|
(let* ((numbers? (nth (1- col) org-table-last-alignment))
|
(cell (match-string 0))
|
(field (match-string 1))
|
(len (max 1 (- (org-string-width cell) 3)))
|
(properly-closed? (/= (match-beginning 2) (match-end 2)))
|
(fmt (format (if numbers? " %%%ds %s" " %%-%ds %s")
|
len
|
(if properly-closed? "|"
|
(setq org-table-may-need-update t)
|
"")))
|
(new-cell
|
(cond ((not new) (format fmt field))
|
((<= (org-string-width new) len) (format fmt new))
|
(t
|
(setq org-table-may-need-update t)
|
(format " %s |" new)))))
|
(unless (equal new-cell cell)
|
(let (org-table-may-need-update)
|
(replace-match new-cell t t)))
|
(goto-char pos))))))))
|
|
;;;###autoload
|
(defun org-table-next-field ()
|
"Go to the next field in the current table, creating new lines as needed.
|
Before doing so, re-align the table if necessary."
|
(interactive)
|
(org-table-maybe-eval-formula)
|
(org-table-maybe-recalculate-line)
|
(if (and org-table-automatic-realign
|
org-table-may-need-update)
|
(org-table-align))
|
(let ((end (org-table-end)))
|
(if (org-at-table-hline-p)
|
(end-of-line 1))
|
(condition-case nil
|
(progn
|
(re-search-forward "|" end)
|
(if (looking-at "[ \t]*$")
|
(re-search-forward "|" end))
|
(if (and (looking-at "-")
|
org-table-tab-jumps-over-hlines
|
(re-search-forward "^[ \t]*|\\([^-]\\)" end t))
|
(goto-char (match-beginning 1)))
|
(if (looking-at "-")
|
(progn
|
(beginning-of-line 0)
|
(org-table-insert-row 'below))
|
(if (looking-at " ") (forward-char 1))))
|
(error
|
(org-table-insert-row 'below)))))
|
|
;;;###autoload
|
(defun org-table-previous-field ()
|
"Go to the previous field in the table.
|
Before doing so, re-align the table if necessary."
|
(interactive)
|
(org-table-justify-field-maybe)
|
(org-table-maybe-recalculate-line)
|
(when (and org-table-automatic-realign
|
org-table-may-need-update)
|
(org-table-align))
|
(when (org-at-table-hline-p)
|
(end-of-line))
|
(let ((start (org-table-begin))
|
(origin (point)))
|
(condition-case nil
|
(progn
|
(search-backward "|" start nil 2)
|
(while (looking-at-p "|\\(?:-\\|[ \t]*$\\)")
|
(search-backward "|" start)))
|
(error
|
(goto-char origin)
|
(user-error "Cannot move to previous table field"))))
|
(when (looking-at "| ?")
|
(goto-char (match-end 0))))
|
|
(defun org-table-beginning-of-field (&optional 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.
|
With numeric argument N, move N-1 fields backward first."
|
(interactive "p")
|
(let ((pos (point)))
|
(while (> n 1)
|
(setq n (1- n))
|
(org-table-previous-field))
|
(if (not (re-search-backward "|" (point-at-bol 0) t))
|
(user-error "No more table fields before the current")
|
(goto-char (match-end 0))
|
(and (looking-at " ") (forward-char 1)))
|
(if (>= (point) pos) (org-table-beginning-of-field 2))))
|
|
(defun org-table-end-of-field (&optional 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."
|
(interactive "p")
|
(let ((pos (point)))
|
(while (> n 1)
|
(setq n (1- n))
|
(org-table-next-field))
|
(when (re-search-forward "|" (point-at-eol 1) t)
|
(backward-char 1)
|
(skip-chars-backward " ")
|
(if (and (equal (char-before (point)) ?|) (looking-at " "))
|
(forward-char 1)))
|
(if (<= (point) pos) (org-table-end-of-field 2))))
|
|
;;;###autoload
|
(defun org-table-next-row ()
|
"Go to the next row (same column) in the current table.
|
Before doing so, re-align the table if necessary."
|
(interactive)
|
(org-table-maybe-eval-formula)
|
(org-table-maybe-recalculate-line)
|
(if (and org-table-automatic-realign
|
org-table-may-need-update)
|
(org-table-align))
|
(let ((col (org-table-current-column)))
|
(beginning-of-line 2)
|
(when (or (not (org-at-table-p))
|
(org-at-table-hline-p))
|
(beginning-of-line 0)
|
(org-table-insert-row 'below))
|
(org-table-goto-column col)
|
(skip-chars-backward "^|\n\r")
|
(when (looking-at " ") (forward-char))))
|
|
;;;###autoload
|
(defun org-table-copy-down (n)
|
"Copy the value of the current field one row below.
|
|
If the field at the cursor is empty, copy the content of the
|
nearest non-empty field above. With argument N, use the Nth
|
non-empty field.
|
|
If the current field is not empty, it is copied down to the next
|
row, and the cursor is moved with it. Therefore, repeating this
|
command causes the column to be filled row-by-row.
|
|
If the variable `org-table-copy-increment' is non-nil and the
|
field is an integer or a timestamp, it will be incremented while
|
copying. By default, increment by the difference between the
|
value in the current field and the one in the field above. To
|
increment using a fixed integer, set `org-table-copy-increment'
|
to a number. In the case of a timestamp, increment by days."
|
(interactive "p")
|
(let* ((colpos (org-table-current-column))
|
(col (current-column))
|
(field (save-excursion (org-table-get-field)))
|
(field-up (or (save-excursion
|
(org-table-get (1- (org-table-current-line))
|
(org-table-current-column))) ""))
|
(non-empty (string-match "[^ \t]" field))
|
(non-empty-up (string-match "[^ \t]" field-up))
|
(beg (org-table-begin))
|
(orig-n n)
|
txt txt-up inc)
|
(org-table-check-inside-data-field)
|
(if (not non-empty)
|
(save-excursion
|
(setq txt
|
(catch 'exit
|
(while (progn (beginning-of-line 1)
|
(re-search-backward org-table-dataline-regexp
|
beg t))
|
(org-table-goto-column colpos t)
|
(if (and (looking-at
|
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
|
(<= (setq n (1- n)) 0))
|
(throw 'exit (match-string 1))))))
|
(setq field-up
|
(catch 'exit
|
(while (progn (beginning-of-line 1)
|
(re-search-backward org-table-dataline-regexp
|
beg t))
|
(org-table-goto-column colpos t)
|
(if (and (looking-at
|
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
|
(<= (setq n (1- n)) 0))
|
(throw 'exit (match-string 1))))))
|
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
|
;; Above field was not empty, go down to the next row
|
(setq txt (org-trim field))
|
(org-table-next-row)
|
(org-table-blank-field))
|
(if non-empty-up (setq txt-up (org-trim field-up)))
|
(setq inc (cond
|
((numberp org-table-copy-increment) org-table-copy-increment)
|
(txt-up (cond ((and (string-match org-ts-regexp3 txt-up)
|
(string-match org-ts-regexp3 txt))
|
(- (org-time-string-to-absolute txt)
|
(org-time-string-to-absolute txt-up)))
|
((string-match org-ts-regexp3 txt) 1)
|
((string-match "\\([-+]\\)?\\(?:[0-9]+\\)?\\(?:\.[0-9]+\\)?" txt-up)
|
(- (string-to-number txt)
|
(string-to-number (match-string 0 txt-up))))
|
(t 1)))
|
(t 1)))
|
(if (not txt)
|
(user-error "No non-empty field found")
|
(if (and org-table-copy-increment
|
(not (equal orig-n 0))
|
(string-match-p "^[-+^/*0-9eE.]+$" txt)
|
(< (string-to-number txt) 100000000))
|
(setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
|
(insert txt)
|
(org-move-to-column col)
|
(if (and org-table-copy-increment (org-at-timestamp-p 'lax))
|
(org-timestamp-up-day inc)
|
(org-table-maybe-recalculate-line))
|
(org-table-align)
|
(org-move-to-column col))))
|
|
(defun org-table-check-inside-data-field (&optional noerror)
|
"Is point inside a table data field?
|
I.e. not on a hline or before the first or after the last column?
|
This actually throws an error, so it aborts the current command."
|
(cond ((and (org-at-table-p)
|
(not (save-excursion (skip-chars-backward " \t") (bolp)))
|
(not (org-at-table-hline-p))
|
(not (looking-at "[ \t]*$"))))
|
(noerror nil)
|
(t (user-error "Not in table data field"))))
|
|
(defvar org-table-clip nil
|
"Clipboard for table regions.")
|
|
(defun org-table-get (line column)
|
"Get the field in table line LINE, column COLUMN.
|
If LINE is larger than the number of data lines in the table, the function
|
returns nil. However, if COLUMN is too large, we will simply return an
|
empty string.
|
If LINE is nil, use the current line.
|
If COLUMN is nil, use the current column."
|
(setq column (or column (org-table-current-column)))
|
(save-excursion
|
(and (or (not line) (org-table-goto-line line))
|
(org-trim (org-table-get-field column)))))
|
|
(defun org-table-put (line column value &optional align)
|
"Put VALUE into line LINE, column COLUMN.
|
When ALIGN is set, also realign the table."
|
(setq column (or column (org-table-current-column)))
|
(prog1 (save-excursion
|
(and (or (not line) (org-table-goto-line line))
|
(progn (org-table-goto-column column nil 'force) t)
|
(org-table-get-field column value)))
|
(and align (org-table-align))))
|
|
(defun org-table-current-line ()
|
"Return the index of the current data line."
|
(let ((pos (point)) (end (org-table-end)) (cnt 0))
|
(save-excursion
|
(goto-char (org-table-begin))
|
(while (and (re-search-forward org-table-dataline-regexp end t)
|
(setq cnt (1+ cnt))
|
(< (point-at-eol) pos))))
|
cnt))
|
|
(defun org-table-goto-line (N)
|
"Go to the Nth data line in the current table.
|
Return t when the line exists, nil if it does not exist."
|
(goto-char (org-table-begin))
|
(let ((end (org-table-end)) (cnt 0))
|
(while (and (re-search-forward org-table-dataline-regexp end t)
|
(< (setq cnt (1+ cnt)) N)))
|
(= cnt N)))
|
|
;;;###autoload
|
(defun org-table-blank-field ()
|
"Blank the current table field or active region."
|
(interactive)
|
(org-table-check-inside-data-field)
|
(if (and (called-interactively-p 'any) (org-region-active-p))
|
(let (org-table-clip)
|
(org-table-cut-region (region-beginning) (region-end)))
|
(skip-chars-backward "^|")
|
(backward-char 1)
|
(if (looking-at "|[^|\n]+")
|
(let* ((pos (match-beginning 0))
|
(match (match-string 0))
|
(len (org-string-width match)))
|
(replace-match (concat "|" (make-string (1- len) ?\ )))
|
(goto-char (+ 2 pos))
|
(substring match 1)))))
|
|
(defun org-table-get-field (&optional n replace)
|
"Return the value of the field in column N of current row.
|
N defaults to current column. If REPLACE is a string, replace
|
field with this value. The return value is always the old
|
value."
|
(when n (org-table-goto-column n))
|
(skip-chars-backward "^|\n")
|
(if (or (bolp) (looking-at-p "[ \t]*$"))
|
;; Before first column or after last one.
|
""
|
(looking-at "[^|\r\n]*")
|
(let* ((pos (match-beginning 0))
|
(val (buffer-substring pos (match-end 0))))
|
(when replace
|
(replace-match (if (equal replace "") " " replace) t t))
|
(goto-char (min (line-end-position) (1+ pos)))
|
val)))
|
|
;;;###autoload
|
(defun org-table-field-info (_arg)
|
"Show info about the current field, and highlight any reference at point."
|
(interactive "P")
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(org-table-analyze)
|
(save-excursion
|
(let* ((pos (point))
|
(col (org-table-current-column))
|
(cname (car (rassoc (int-to-string col) org-table-column-names)))
|
(name (car (rassoc (list (count-lines org-table-current-begin-pos
|
(line-beginning-position))
|
col)
|
org-table-named-field-locations)))
|
(eql (org-table-expand-lhs-ranges
|
(mapcar
|
(lambda (e)
|
(cons (org-table-formula-handle-first/last-rc (car e))
|
(cdr e)))
|
(org-table-get-stored-formulas))))
|
(dline (org-table-current-dline))
|
(ref (format "@%d$%d" dline col))
|
(ref1 (org-table-convert-refs-to-an ref))
|
;; Prioritize field formulas over column formulas.
|
(fequation (or (assoc name eql) (assoc ref eql)))
|
(cequation (assoc (format "$%d" col) eql))
|
(eqn (or fequation cequation)))
|
(let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn)))))
|
(when p (setq eqn p)))
|
(goto-char pos)
|
(ignore-errors (org-table-show-reference 'local))
|
(message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
|
dline col
|
(if cname (concat " or $" cname) "")
|
dline col ref1
|
(if name (concat " or $" name) "")
|
;; FIXME: formula info not correct if special table line
|
(if eqn
|
(concat ", formula: "
|
(org-table-formula-to-user
|
(concat
|
(if (or (string-prefix-p "$" (car eqn))
|
(string-prefix-p "@" (car eqn)))
|
""
|
"$")
|
(car eqn) "=" (cdr eqn))))
|
"")))))
|
|
(defun org-table-current-column ()
|
"Find out which column we are in."
|
(interactive)
|
(save-excursion
|
(let ((column 0) (pos (point)))
|
(beginning-of-line)
|
(while (search-forward "|" pos t) (cl-incf column))
|
column)))
|
|
(defun org-table-current-dline ()
|
"Find out what table data line we are in.
|
Only data lines count for this."
|
(save-excursion
|
(let ((c 0)
|
(pos (line-beginning-position)))
|
(goto-char (org-table-begin))
|
(while (<= (point) pos)
|
(when (looking-at org-table-dataline-regexp) (cl-incf c))
|
(forward-line))
|
c)))
|
|
;;;###autoload
|
(defun org-table-goto-column (n &optional on-delim force)
|
"Move the cursor to the Nth column in the current table line.
|
With optional argument ON-DELIM, stop with point before the left delimiter
|
of the field.
|
If there are less than N fields, just go to after the last delimiter.
|
However, when FORCE is non-nil, create new columns if necessary."
|
(interactive "p")
|
(beginning-of-line 1)
|
(when (> n 0)
|
(while (and (> (setq n (1- n)) -1)
|
(or (search-forward "|" (point-at-eol) t)
|
(and force
|
(progn (end-of-line 1)
|
(skip-chars-backward "^|")
|
(insert " | ")
|
t)))))
|
(when (and force (not (looking-at ".*|")))
|
(save-excursion (end-of-line 1) (insert " | ")))
|
(if on-delim
|
(backward-char 1)
|
(if (looking-at " ") (forward-char 1)))))
|
|
;;;###autoload
|
(defun org-table-insert-column ()
|
"Insert a new column into the table."
|
(interactive)
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(org-table-find-dataline)
|
(let* ((col (max 1 (org-table-current-column)))
|
(beg (org-table-begin))
|
(end (copy-marker (org-table-end))))
|
(org-table-save-field
|
(goto-char beg)
|
(while (< (point) end)
|
(unless (org-at-table-hline-p)
|
(org-table-goto-column col t)
|
(insert "| "))
|
(forward-line)))
|
(set-marker end nil)
|
(org-table-align)
|
(when (or (not org-table-fix-formulas-confirm)
|
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
|
(org-table-fix-formulas "$" nil (1- col) 1)
|
(org-table-fix-formulas "$LR" nil (1- col) 1))))
|
|
(defun org-table-find-dataline ()
|
"Find a data line in the current table, which is needed for column commands."
|
(if (and (org-at-table-p)
|
(not (org-at-table-hline-p)))
|
t
|
(let ((col (current-column))
|
(end (org-table-end)))
|
(org-move-to-column col)
|
(while (and (< (point) end)
|
(or (not (= (current-column) col))
|
(org-at-table-hline-p)))
|
(beginning-of-line 2)
|
(org-move-to-column col))
|
(if (and (org-at-table-p)
|
(not (org-at-table-hline-p)))
|
t
|
(user-error
|
"Please position cursor in a data line for column operations")))))
|
|
(defun org-table-line-to-dline (line &optional above)
|
"Turn a buffer line number into a data line number.
|
|
If there is no data line in this line, return nil.
|
|
If there is no matching dline (most likely the reference was
|
a hline), the first dline below it is used. When ABOVE is
|
non-nil, the one above is used."
|
(let ((min 1)
|
(max (1- (length org-table-dlines))))
|
(cond ((or (> (aref org-table-dlines min) line)
|
(< (aref org-table-dlines max) line))
|
nil)
|
((= (aref org-table-dlines max) line) max)
|
(t (catch 'exit
|
(while (> (- max min) 1)
|
(let* ((mean (/ (+ max min) 2))
|
(v (aref org-table-dlines mean)))
|
(cond ((= v line) (throw 'exit mean))
|
((> v line) (setq max mean))
|
(t (setq min mean)))))
|
(if above min max))))))
|
|
;;;###autoload
|
(defun org-table-delete-column ()
|
"Delete a column from the table."
|
(interactive)
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(org-table-find-dataline)
|
(org-table-check-inside-data-field)
|
(let ((col (org-table-current-column))
|
(beg (org-table-begin))
|
(end (copy-marker (org-table-end))))
|
(org-table-save-field
|
(goto-char beg)
|
(while (< (point) end)
|
(if (org-at-table-hline-p)
|
nil
|
(org-table-goto-column col t)
|
(and (looking-at "|[^|\n]+|")
|
(replace-match "|")))
|
(forward-line)))
|
(set-marker end nil)
|
(org-table-goto-column (max 1 (1- col)))
|
(org-table-align)
|
(when (or (not org-table-fix-formulas-confirm)
|
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
|
(org-table-fix-formulas
|
"$" (list (cons (number-to-string col) "INVALID")) col -1 col)
|
(org-table-fix-formulas
|
"$LR" (list (cons (number-to-string col) "INVALID")) col -1 col))))
|
|
;;;###autoload
|
(defun org-table-move-column-right ()
|
"Move column to the right."
|
(interactive)
|
(org-table-move-column nil))
|
;;;###autoload
|
(defun org-table-move-column-left ()
|
"Move column to the left."
|
(interactive)
|
(org-table-move-column 'left))
|
|
;;;###autoload
|
(defun org-table-move-column (&optional left)
|
"Move the current column to the right. With arg LEFT, move to the left."
|
(interactive "P")
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(org-table-find-dataline)
|
(org-table-check-inside-data-field)
|
(let* ((col (org-table-current-column))
|
(col1 (if left (1- col) col))
|
(colpos (if left (1- col) (1+ col)))
|
(beg (org-table-begin))
|
(end (copy-marker (org-table-end))))
|
(when (and left (= col 1))
|
(user-error "Cannot move column further left"))
|
(when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
|
(user-error "Cannot move column further right"))
|
(org-table-save-field
|
(goto-char beg)
|
(while (< (point) end)
|
(unless (org-at-table-hline-p)
|
(org-table-goto-column col1 t)
|
(when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
|
(transpose-regions
|
(match-beginning 1) (match-end 1)
|
(match-beginning 2) (match-end 2))))
|
(forward-line)))
|
(set-marker end nil)
|
(org-table-goto-column colpos)
|
(org-table-align)
|
(when (or (not org-table-fix-formulas-confirm)
|
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
|
(org-table-fix-formulas
|
"$" (list (cons (number-to-string col) (number-to-string colpos))
|
(cons (number-to-string colpos) (number-to-string col))))
|
(org-table-fix-formulas
|
"$LR" (list (cons (number-to-string col) (number-to-string colpos))
|
(cons (number-to-string colpos) (number-to-string col)))))))
|
|
;;;###autoload
|
(defun org-table-move-row-down ()
|
"Move table row down."
|
(interactive)
|
(org-table-move-row nil))
|
;;;###autoload
|
(defun org-table-move-row-up ()
|
"Move table row up."
|
(interactive)
|
(org-table-move-row 'up))
|
|
;;;###autoload
|
(defun org-table-move-row (&optional up)
|
"Move the current table line down. With arg UP, move it up."
|
(interactive "P")
|
(let* ((col (current-column))
|
(pos (point))
|
(hline1p (save-excursion (beginning-of-line 1)
|
(looking-at org-table-hline-regexp)))
|
(dline1 (org-table-current-dline))
|
(dline2 (+ dline1 (if up -1 1)))
|
(tonew (if up 0 2))
|
hline2p)
|
(when (and up (= (point-min) (line-beginning-position)))
|
(user-error "Cannot move row further"))
|
(beginning-of-line tonew)
|
(when (or (and (not up) (eobp)) (not (org-at-table-p)))
|
(goto-char pos)
|
(user-error "Cannot move row further"))
|
(setq hline2p (looking-at org-table-hline-regexp))
|
(goto-char pos)
|
(let ((row (delete-and-extract-region (line-beginning-position)
|
(line-beginning-position 2))))
|
(beginning-of-line tonew)
|
(unless (bolp) (insert "\n")) ;at eob without a newline
|
(insert row)
|
(unless (bolp) (insert "\n")) ;missing final newline in ROW
|
(beginning-of-line 0)
|
(org-move-to-column col)
|
(unless (or hline1p hline2p
|
(not (or (not org-table-fix-formulas-confirm)
|
(funcall org-table-fix-formulas-confirm
|
"Fix formulas? "))))
|
(org-table-fix-formulas
|
"@" (list
|
(cons (number-to-string dline1) (number-to-string dline2))
|
(cons (number-to-string dline2) (number-to-string dline1))))))))
|
|
;;;###autoload
|
(defun org-table-insert-row (&optional arg)
|
"Insert a new row above the current line into the table.
|
With prefix ARG, insert below the current line."
|
(interactive "P")
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
|
(new (org-table-clean-line line)))
|
;; Fix the first field if necessary
|
(if (string-match "^[ \t]*| *[#$] *|" line)
|
(setq new (replace-match (match-string 0 line) t t new)))
|
(beginning-of-line (if arg 2 1))
|
;; Buffer may not end of a newline character, so ensure
|
;; (beginning-of-line 2) moves point to a new line.
|
(unless (bolp) (insert "\n"))
|
(let (org-table-may-need-update) (insert-before-markers new "\n"))
|
(beginning-of-line 0)
|
(re-search-forward "| ?" (line-end-position) t)
|
(when (or org-table-may-need-update org-table-overlay-coordinates)
|
(org-table-align))
|
(when (or (not org-table-fix-formulas-confirm)
|
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
|
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
|
|
;;;###autoload
|
(defun org-table-insert-hline (&optional above)
|
"Insert a horizontal-line below the current line into the table.
|
With prefix ABOVE, insert above the current line."
|
(interactive "P")
|
(if (not (org-at-table-p))
|
(user-error "Not at a table"))
|
(when (eobp) (insert "\n") (backward-char 1))
|
(if (not (string-match-p "|[ \t]*$" (org-current-line-string)))
|
(org-table-align))
|
(let ((line (org-table-clean-line
|
(buffer-substring (point-at-bol) (point-at-eol))))
|
(col (current-column)))
|
(while (string-match "|\\( +\\)|" line)
|
(setq line (replace-match
|
(concat "+" (make-string (- (match-end 1) (match-beginning 1))
|
?-) "|") t t line)))
|
(and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
|
(beginning-of-line (if above 1 2))
|
(insert line "\n")
|
(beginning-of-line (if above 1 -1))
|
(org-move-to-column col)
|
(and org-table-overlay-coordinates (org-table-align))))
|
|
;;;###autoload
|
(defun org-table-hline-and-move (&optional same-column)
|
"Insert a hline and move to the row below that line."
|
(interactive "P")
|
(let ((col (org-table-current-column)))
|
(org-table-maybe-eval-formula)
|
(org-table-maybe-recalculate-line)
|
(org-table-insert-hline)
|
(end-of-line 2)
|
(if (looking-at "\n[ \t]*|-")
|
(progn (insert "\n|") (org-table-align))
|
(org-table-next-field))
|
(if same-column (org-table-goto-column col))))
|
|
(defun org-table-clean-line (s)
|
"Convert a table line S into a string with only \"|\" and space.
|
In particular, this does handle wide and invisible characters."
|
(if (string-match "^[ \t]*|-" s)
|
;; It's a hline, just map the characters
|
(setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
|
(while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
|
(setq s (replace-match
|
(concat "|" (make-string (org-string-width (match-string 1 s))
|
?\ ) "|")
|
t t s)))
|
s))
|
|
;;;###autoload
|
(defun org-table-kill-row ()
|
"Delete the current row or horizontal line from the table."
|
(interactive)
|
(if (not (org-at-table-p))
|
(user-error "Not at a table"))
|
(let ((col (current-column))
|
(dline (and (not (org-match-line org-table-hline-regexp))
|
(org-table-current-dline))))
|
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
|
(if (not (org-at-table-p)) (beginning-of-line 0))
|
(org-move-to-column col)
|
(when (and dline
|
(or (not org-table-fix-formulas-confirm)
|
(funcall org-table-fix-formulas-confirm "Fix formulas? ")))
|
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
|
dline -1 dline))))
|
|
;;;###autoload
|
(defun org-table-sort-lines
|
(&optional with-case sorting-type getkey-func compare-func interactive?)
|
"Sort table lines according to the column at point.
|
|
The position of point indicates the column to be used for
|
sorting, and the range of lines is the range between the nearest
|
horizontal separator lines, or the entire table of no such lines
|
exist. If point is before the first column, you will be prompted
|
for the sorting column. If there is an active region, the mark
|
specifies the first line and the sorting column, while point
|
should be in the last line to be included into the sorting.
|
|
The command then prompts for the sorting type which can be
|
alphabetically, numerically, or by time (as given in a time stamp
|
in the field, or as a HH:MM value). Sorting in reverse order is
|
also possible.
|
|
With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
|
|
If SORTING-TYPE is specified when this function is called from a Lisp
|
program, no prompting will take place. SORTING-TYPE must be a character,
|
any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
|
sorting should be done in reverse order.
|
|
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
|
a function to be called to extract the key. It must return a value
|
that is compatible with COMPARE-FUNC, the function used to compare
|
entries.
|
|
A non-nil value for INTERACTIVE? is used to signal that this
|
function is being called interactively."
|
(interactive (list current-prefix-arg nil nil nil t))
|
(when (org-region-active-p) (goto-char (region-beginning)))
|
;; Point must be either within a field or before a data line.
|
(save-excursion
|
(skip-chars-backward " \t")
|
(when (bolp) (search-forward "|" (line-end-position) t))
|
(org-table-check-inside-data-field))
|
;; Set appropriate case sensitivity and column used for sorting.
|
(let ((column (let ((c (org-table-current-column)))
|
(cond ((> c 0) c)
|
(interactive?
|
(read-number "Use column N for sorting: "))
|
(t 1))))
|
(sorting-type
|
(or sorting-type
|
(read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \
|
\[t]ime, [f]unc. A/N/T/F means reversed: "))))
|
(save-restriction
|
;; Narrow buffer to appropriate sorting area.
|
(if (org-region-active-p)
|
(progn (goto-char (region-beginning))
|
(narrow-to-region
|
(point)
|
(save-excursion (goto-char (region-end))
|
(line-beginning-position 2))))
|
(let ((start (org-table-begin))
|
(end (org-table-end)))
|
(narrow-to-region
|
(save-excursion
|
(if (re-search-backward org-table-hline-regexp start t)
|
(line-beginning-position 2)
|
start))
|
(if (save-excursion (re-search-forward org-table-hline-regexp end t))
|
(match-beginning 0)
|
end))))
|
;; Determine arguments for `sort-subr'. Also record original
|
;; position. `org-table-save-field' cannot help here since
|
;; sorting is too much destructive.
|
(let* ((sort-fold-case (not with-case))
|
(coordinates
|
(cons (count-lines (point-min) (line-beginning-position))
|
(current-column)))
|
(extract-key-from-field
|
;; Function to be called on the contents of the field
|
;; used for sorting in the current row.
|
(cl-case sorting-type
|
((?n ?N) #'string-to-number)
|
((?a ?A) #'org-sort-remove-invisible)
|
((?t ?T)
|
(lambda (f)
|
(cond ((string-match org-ts-regexp-both f)
|
(float-time
|
(org-time-string-to-time (match-string 0 f))))
|
((org-duration-p f) (org-duration-to-minutes f))
|
((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f)
|
(org-duration-to-minutes (match-string 0 f)))
|
(t 0))))
|
((?f ?F)
|
(or getkey-func
|
(and interactive?
|
(org-read-function "Function for extracting keys: "))
|
(error "Missing key extractor to sort rows")))
|
(t (user-error "Invalid sorting type `%c'" sorting-type))))
|
(predicate
|
(cl-case sorting-type
|
((?n ?N ?t ?T) #'<)
|
((?a ?A) #'string<)
|
((?f ?F)
|
(or compare-func
|
(and interactive?
|
(org-read-function
|
(concat "Function for comparing keys "
|
"(empty for default `sort-subr' predicate): ")
|
'allow-empty)))))))
|
(goto-char (point-min))
|
(sort-subr (memq sorting-type '(?A ?N ?T ?F))
|
(lambda ()
|
(forward-line)
|
(while (and (not (eobp))
|
(not (looking-at org-table-dataline-regexp)))
|
(forward-line)))
|
#'end-of-line
|
(lambda ()
|
(funcall extract-key-from-field
|
(org-trim (org-table-get-field column))))
|
nil
|
predicate)
|
;; Move back to initial field.
|
(forward-line (car coordinates))
|
(move-to-column (cdr coordinates))))))
|
|
;;;###autoload
|
(defun org-table-cut-region (beg end)
|
"Copy region in table to the clipboard and blank all relevant fields.
|
If there is no active region, use just the field at point."
|
(interactive (list
|
(if (org-region-active-p) (region-beginning) (point))
|
(if (org-region-active-p) (region-end) (point))))
|
(org-table-copy-region beg end 'cut))
|
|
;;;###autoload
|
(defun org-table-copy-region (beg end &optional cut)
|
"Copy rectangular region in table to clipboard.
|
A special clipboard is used which can only be accessed
|
with `org-table-paste-rectangle'."
|
(interactive (list
|
(if (org-region-active-p) (region-beginning) (point))
|
(if (org-region-active-p) (region-end) (point))
|
current-prefix-arg))
|
(goto-char (min beg end))
|
(org-table-check-inside-data-field)
|
(let ((beg (line-beginning-position))
|
(c01 (org-table-current-column))
|
region)
|
(goto-char (max beg end))
|
(org-table-check-inside-data-field)
|
(let* ((end (copy-marker (line-end-position)))
|
(c02 (org-table-current-column))
|
(column-start (min c01 c02))
|
(column-end (max c01 c02))
|
(column-number (1+ (- column-end column-start)))
|
(rpl (and cut " ")))
|
(goto-char beg)
|
(while (< (point) end)
|
(unless (org-at-table-hline-p)
|
;; Collect every cell between COLUMN-START and COLUMN-END.
|
(let (cols)
|
(dotimes (c column-number)
|
(push (org-table-get-field (+ c column-start) rpl) cols))
|
(push (nreverse cols) region)))
|
(forward-line))
|
(set-marker end nil))
|
(when cut (org-table-align))
|
(setq org-table-clip (nreverse region))))
|
|
;;;###autoload
|
(defun org-table-paste-rectangle ()
|
"Paste a rectangular region into a table.
|
The upper right corner ends up in the current field. All involved fields
|
will be overwritten. If the rectangle does not fit into the present table,
|
the table is enlarged as needed. The process ignores horizontal separator
|
lines."
|
(interactive)
|
(unless (consp org-table-clip)
|
(user-error "First cut/copy a region to paste!"))
|
(org-table-check-inside-data-field)
|
(let* ((column (org-table-current-column))
|
(org-table-automatic-realign nil))
|
(org-table-save-field
|
(dolist (row org-table-clip)
|
(while (org-at-table-hline-p) (forward-line))
|
;; If we left the table, create a new row.
|
(when (and (bolp) (not (looking-at "[ \t]*|")))
|
(end-of-line 0)
|
(org-table-next-field))
|
(let ((c column))
|
(dolist (field row)
|
(org-table-goto-column c nil 'force)
|
(org-table-get-field nil field)
|
(cl-incf c)))
|
(forward-line)))
|
(org-table-align)))
|
|
;;;###autoload
|
(defun org-table-convert ()
|
"Convert from `org-mode' table to table.el and back.
|
Obviously, this only works within limits. When an Org table is converted
|
to table.el, all horizontal separator lines get lost, because table.el uses
|
these as cell boundaries and has no notion of horizontal lines. A table.el
|
table can be converted to an Org table only if it does not do row or column
|
spanning. Multiline cells will become multiple cells. Beware, Org mode
|
does not test if the table can be successfully converted - it blindly
|
applies a recipe that works for simple tables."
|
(interactive)
|
(require 'table)
|
(if (org-at-table.el-p)
|
;; convert to Org table
|
(let ((beg (copy-marker (org-table-begin t)))
|
(end (copy-marker (org-table-end t))))
|
(table-unrecognize-region beg end)
|
(goto-char beg)
|
(while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t)
|
(replace-match ""))
|
(goto-char beg))
|
(if (org-at-table-p)
|
;; convert to table.el table
|
(let ((beg (copy-marker (org-table-begin)))
|
(end (copy-marker (org-table-end))))
|
;; first, get rid of all horizontal lines
|
(goto-char beg)
|
(while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
|
(replace-match ""))
|
;; insert a hline before first
|
(goto-char beg)
|
(org-table-insert-hline 'above)
|
(beginning-of-line -1)
|
;; insert a hline after each line
|
(while (progn (beginning-of-line 3) (< (point) end))
|
(org-table-insert-hline))
|
(goto-char beg)
|
(setq end (move-marker end (org-table-end)))
|
;; replace "+" at beginning and ending of hlines
|
(while (re-search-forward "^\\([ \t]*\\)|-" end t)
|
(replace-match "\\1+-"))
|
(goto-char beg)
|
(while (re-search-forward "-|[ \t]*$" end t)
|
(replace-match "-+"))
|
(goto-char beg)))))
|
|
(defun org-table-transpose-table-at-point ()
|
"Transpose Org table at point and eliminate hlines.
|
So a table like
|
|
| 1 | 2 | 4 | 5 |
|
|---+---+---+---|
|
| a | b | c | d |
|
| e | f | g | h |
|
|
will be transposed as
|
|
| 1 | a | e |
|
| 2 | b | f |
|
| 4 | c | g |
|
| 5 | d | h |
|
|
Note that horizontal lines disappear."
|
(interactive)
|
(let* ((table (delete 'hline (org-table-to-lisp)))
|
(dline_old (org-table-current-line))
|
(col_old (org-table-current-column))
|
(contents (mapcar (lambda (_)
|
(let ((tp table))
|
(mapcar
|
(lambda (_)
|
(prog1
|
(pop (car tp))
|
(setq tp (cdr tp))))
|
table)))
|
(car table))))
|
(goto-char (org-table-begin))
|
(re-search-forward "|")
|
(backward-char)
|
(delete-region (point) (org-table-end))
|
(insert (mapconcat
|
(lambda(x)
|
(concat "| " (mapconcat 'identity x " | " ) " |\n" ))
|
contents ""))
|
(org-table-goto-line col_old)
|
(org-table-goto-column dline_old))
|
(org-table-align))
|
|
;;;###autoload
|
(defun org-table-wrap-region (arg)
|
"Wrap several fields in a column like a paragraph.
|
This is useful if you'd like to spread the contents of a field over several
|
lines, in order to keep the table compact.
|
|
If there is an active region, and both point and mark are in the same column,
|
the text in the column is wrapped to minimum width for the given number of
|
lines. Generally, this makes the table more compact. A prefix ARG may be
|
used to change the number of desired lines. For example, \
|
`C-2 \\[org-table-wrap-region]'
|
formats the selected text to two lines. If the region was longer than two
|
lines, the remaining lines remain empty. A negative prefix argument reduces
|
the current number of lines by that amount. The wrapped text is pasted back
|
into the table. If you formatted it to more lines than it was before, fields
|
further down in the table get overwritten - so you might need to make space in
|
the table first.
|
|
If there is no region, the current field is split at the cursor position and
|
the text fragment to the right of the cursor is prepended to the field one
|
line down.
|
|
If there is no region, but you specify a prefix ARG, the current field gets
|
blank, and the content is appended to the field above."
|
(interactive "P")
|
(org-table-check-inside-data-field)
|
(if (org-region-active-p)
|
;; There is a region: fill as a paragraph.
|
(let ((start (region-beginning)))
|
(org-table-cut-region (region-beginning) (region-end))
|
(when (> (length (car org-table-clip)) 1)
|
(user-error "Region must be limited to single column"))
|
(let ((nlines (cond ((not arg) (length org-table-clip))
|
((< arg 1) (+ (length org-table-clip) arg))
|
(t arg))))
|
(setq org-table-clip
|
(mapcar #'list
|
(org-wrap (mapconcat #'car org-table-clip " ")
|
nil
|
nlines))))
|
(goto-char start)
|
(org-table-paste-rectangle))
|
;; No region, split the current field at point.
|
(unless (org-get-alist-option org-M-RET-may-split-line 'table)
|
(skip-chars-forward "^\r\n|"))
|
(cond
|
(arg ; Combine with field above.
|
(let ((s (org-table-blank-field))
|
(col (org-table-current-column)))
|
(forward-line -1)
|
(while (org-at-table-hline-p) (forward-line -1))
|
(org-table-goto-column col)
|
(skip-chars-forward "^|")
|
(skip-chars-backward " ")
|
(insert " " (org-trim s))
|
(org-table-align)))
|
((looking-at "\\([^|]+\\)+|") ; Split field.
|
(let ((s (match-string 1)))
|
(replace-match " |")
|
(goto-char (match-beginning 0))
|
(org-table-next-row)
|
(insert (org-trim s) " ")
|
(org-table-align)))
|
(t (org-table-next-row)))))
|
|
(defvar org-field-marker nil)
|
|
;;;###autoload
|
(defun org-table-edit-field (arg)
|
"Edit table field in a different window.
|
This is mainly useful for fields that contain hidden parts.
|
|
When called with a `\\[universal-argument]' prefix, just make the full field
|
visible so that it can be edited in place.
|
|
When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
|
toggle `org-table-follow-field-mode'."
|
(interactive "P")
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(cond
|
((equal arg '(16))
|
(org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
|
(arg
|
(let ((b (save-excursion (skip-chars-backward "^|") (point)))
|
(e (save-excursion (skip-chars-forward "^|\r\n") (point))))
|
(remove-text-properties b e '(org-cwidth t invisible t
|
display t intangible t))
|
(if (and (boundp 'font-lock-mode) font-lock-mode)
|
(font-lock-fontify-block))))
|
(t
|
(let ((pos (point-marker))
|
(coord
|
(if (eq org-table-use-standard-references t)
|
(concat (org-number-to-letters (org-table-current-column))
|
(int-to-string (org-table-current-dline)))
|
(concat "@" (int-to-string (org-table-current-dline))
|
"$" (int-to-string (org-table-current-column)))))
|
(field (org-table-get-field))
|
(cw (current-window-configuration))
|
p)
|
(goto-char pos)
|
(org-switch-to-buffer-other-window "*Org Table Edit Field*")
|
(when (and (local-variable-p 'org-field-marker)
|
(markerp org-field-marker))
|
(move-marker org-field-marker nil))
|
(erase-buffer)
|
(insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n")
|
(let ((org-inhibit-startup t)) (org-mode))
|
(auto-fill-mode -1)
|
(setq truncate-lines nil)
|
(setq word-wrap t)
|
(goto-char (setq p (point-max)))
|
(insert (org-trim field))
|
(remove-text-properties p (point-max)
|
'(invisible t org-cwidth t display t
|
intangible t))
|
(goto-char p)
|
(setq-local org-finish-function 'org-table-finish-edit-field)
|
(setq-local org-window-configuration cw)
|
(setq-local org-field-marker pos)
|
(message "Edit and finish with C-c C-c")))))
|
|
(defun org-table-finish-edit-field ()
|
"Finish editing a table data field.
|
Remove all newline characters, insert the result into the table, realign
|
the table and kill the editing buffer."
|
(let ((pos org-field-marker)
|
(cw org-window-configuration)
|
(cb (current-buffer))
|
text)
|
(goto-char (point-min))
|
(while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
|
(while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t)
|
(replace-match " "))
|
(setq text (org-trim (buffer-string)))
|
(set-window-configuration cw)
|
(kill-buffer cb)
|
(select-window (get-buffer-window (marker-buffer pos)))
|
(goto-char pos)
|
(move-marker pos nil)
|
(org-table-check-inside-data-field)
|
(org-table-get-field nil text)
|
(org-table-align)
|
(message "New field value inserted")))
|
|
(define-minor-mode org-table-follow-field-mode
|
"Minor mode to make the table field editor window follow the cursor.
|
When this mode is active, the field editor window will always show the
|
current field. The mode exits automatically when the cursor leaves the
|
table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
|
nil " TblFollow" nil
|
(if org-table-follow-field-mode
|
(add-hook 'post-command-hook 'org-table-follow-fields-with-editor
|
'append 'local)
|
(remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
|
(let* ((buf (get-buffer "*Org Table Edit Field*"))
|
(win (and buf (get-buffer-window buf))))
|
(when win (delete-window win))
|
(when buf
|
(with-current-buffer buf
|
(move-marker org-field-marker nil))
|
(kill-buffer buf)))))
|
|
(defun org-table-follow-fields-with-editor ()
|
(if (and org-table-exit-follow-field-mode-when-leaving-table
|
(not (org-at-table-p)))
|
;; We have left the table, exit the follow mode
|
(org-table-follow-field-mode -1)
|
(when (org-table-check-inside-data-field 'noerror)
|
(let ((win (selected-window)))
|
(org-table-edit-field nil)
|
(org-fit-window-to-buffer)
|
(select-window win)))))
|
|
(defvar org-timecnt) ; dynamically scoped parameter
|
|
;;;###autoload
|
(defun org-table-sum (&optional beg end nlast)
|
"Sum numbers in region of current table column.
|
The result will be displayed in the echo area, and will be available
|
as kill to be inserted with \\[yank].
|
|
If there is an active region, it is interpreted as a rectangle and all
|
numbers in that rectangle will be summed. If there is no active
|
region and point is located in a table column, sum all numbers in that
|
column.
|
|
If at least one number looks like a time HH:MM or HH:MM:SS, all other
|
numbers are assumed to be times as well (in decimal hours) and the
|
numbers are added as such.
|
|
If NLAST is a number, only the NLAST fields will actually be summed."
|
(interactive)
|
(save-excursion
|
(let (col (org-timecnt 0) diff h m s org-table-clip)
|
(cond
|
((and beg end)) ; beg and end given explicitly
|
((org-region-active-p)
|
(setq beg (region-beginning) end (region-end)))
|
(t
|
(setq col (org-table-current-column))
|
(goto-char (org-table-begin))
|
(unless (re-search-forward "^[ \t]*|[^-]" nil t)
|
(user-error "No table data"))
|
(org-table-goto-column col)
|
(setq beg (point))
|
(goto-char (org-table-end))
|
(unless (re-search-backward "^[ \t]*|[^-]" nil t)
|
(user-error "No table data"))
|
(org-table-goto-column col)
|
(setq end (point))))
|
(let* ((items (apply 'append (org-table-copy-region beg end)))
|
(items1 (cond ((not nlast) items)
|
((>= nlast (length items)) items)
|
(t (setq items (reverse items))
|
(setcdr (nthcdr (1- nlast) items) nil)
|
(nreverse items))))
|
(numbers (delq nil (mapcar 'org-table-get-number-for-summing
|
items1)))
|
(res (apply '+ numbers))
|
(sres (if (= org-timecnt 0)
|
(number-to-string res)
|
(setq diff (* 3600 res)
|
h (floor (/ diff 3600)) diff (mod diff 3600)
|
m (floor (/ diff 60)) diff (mod diff 60)
|
s diff)
|
(format "%.0f:%02.0f:%02.0f" h m s))))
|
(kill-new sres)
|
(when (called-interactively-p 'interactive)
|
(message "%s" (substitute-command-keys
|
(format "Sum of %d items: %-20s \
|
\(\\[yank] will insert result into buffer)" (length numbers) sres))))
|
sres))))
|
|
(defun org-table-get-number-for-summing (s)
|
(let (n)
|
(if (string-match "^ *|? *" s)
|
(setq s (replace-match "" nil nil s)))
|
(if (string-match " *|? *$" s)
|
(setq s (replace-match "" nil nil s)))
|
(setq n (string-to-number s))
|
(cond
|
((and (string-match "0" s)
|
(string-match "\\`[-+ \t0.edED]+\\'" s)) 0)
|
((string-match "\\`[ \t]+\\'" s) nil)
|
((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s)
|
(let ((h (string-to-number (or (match-string 1 s) "0")))
|
(m (string-to-number (or (match-string 2 s) "0")))
|
(s (string-to-number (or (match-string 4 s) "0"))))
|
(if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt)))
|
(* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
|
((equal n 0) nil)
|
(t n))))
|
|
(defun org-table-current-field-formula (&optional key noerror)
|
"Return the formula active for the current field.
|
|
Assumes that table is already analyzed. If KEY is given, return
|
the key to this formula. Otherwise return the formula preceded
|
with \"=\" or \":=\"."
|
(let* ((line (count-lines org-table-current-begin-pos
|
(line-beginning-position)))
|
(row (org-table-line-to-dline line)))
|
(cond
|
(row
|
(let* ((col (org-table-current-column))
|
(name (car (rassoc (list line col)
|
org-table-named-field-locations)))
|
(scol (format "$%d" col))
|
(ref (format "@%d$%d" (org-table-current-dline) col))
|
(stored-list (org-table-get-stored-formulas noerror))
|
(ass (or (assoc name stored-list)
|
(assoc ref stored-list)
|
(assoc scol stored-list))))
|
(cond (key (car ass))
|
(ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=")
|
(cdr ass))))))
|
(noerror nil)
|
(t (error "No formula active for the current field")))))
|
|
(defun org-table-get-formula (&optional equation named)
|
"Read a formula from the minibuffer, offer stored formula as default.
|
When NAMED is non-nil, look for a named equation."
|
(let* ((stored-list (org-table-get-stored-formulas))
|
(name (car (rassoc (list (count-lines org-table-current-begin-pos
|
(line-beginning-position))
|
(org-table-current-column))
|
org-table-named-field-locations)))
|
(ref (format "@%d$%d"
|
(org-table-current-dline)
|
(org-table-current-column)))
|
(scol (cond
|
((not named) (format "$%d" (org-table-current-column)))
|
((and name (not (string-match "\\`LR[0-9]+\\'" name))) name)
|
(t ref)))
|
(name (or name ref))
|
(org-table-may-need-update nil)
|
(stored (cdr (assoc scol stored-list)))
|
(eq (cond
|
((and stored equation (string-match-p "^ *=? *$" equation))
|
stored)
|
((stringp equation)
|
equation)
|
(t (org-table-formula-from-user
|
(read-string
|
(org-table-formula-to-user
|
(format "%s formula %s="
|
(if named "Field" "Column")
|
scol))
|
(if stored (org-table-formula-to-user stored) "")
|
'org-table-formula-history
|
)))))
|
mustsave)
|
(when (not (string-match "\\S-" eq))
|
;; remove formula
|
(setq stored-list (delq (assoc scol stored-list) stored-list))
|
(org-table-store-formulas stored-list)
|
(user-error "Formula removed"))
|
(if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
|
(if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
|
(if (and name (not named))
|
;; We set the column equation, delete the named one.
|
(setq stored-list (delq (assoc name stored-list) stored-list)
|
mustsave t))
|
(if stored
|
(setcdr (assoc scol stored-list) eq)
|
(setq stored-list (cons (cons scol eq) stored-list)))
|
(if (or mustsave (not (equal stored eq)))
|
(org-table-store-formulas stored-list))
|
eq))
|
|
(defun org-table-store-formulas (alist &optional location)
|
"Store the list of formulas below the current table.
|
If optional argument LOCATION is a buffer position, insert it at
|
LOCATION instead."
|
(save-excursion
|
(if location
|
(progn (goto-char location) (beginning-of-line))
|
(goto-char (org-table-end)))
|
(let ((case-fold-search t))
|
(if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)")
|
(progn
|
;; Don't overwrite TBLFM, we might use text properties to
|
;; store stuff.
|
(goto-char (match-beginning 3))
|
(delete-region (match-beginning 3) (match-end 0)))
|
(org-indent-line)
|
(insert (or (match-string 2) "#+TBLFM:")))
|
(insert " "
|
(mapconcat (lambda (x) (concat (car x) "=" (cdr x)))
|
(sort alist #'org-table-formula-less-p)
|
"::")
|
"\n"))))
|
|
(defsubst org-table-formula-make-cmp-string (a)
|
(when (string-match "\\`$[<>]" a)
|
(let ((arrow (string-to-char (substring a 1))))
|
;; Fake a high number to make sure this is sorted at the end.
|
(setq a (org-table-formula-handle-first/last-rc a))
|
(setq a (format "$%d" (+ 10000
|
(if (= arrow ?<) -1000 0)
|
(string-to-number (substring a 1)))))))
|
(when (string-match
|
"^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?"
|
a)
|
(concat
|
(if (match-end 2)
|
(format "@%05d" (string-to-number (match-string 2 a))) "")
|
(if (match-end 4)
|
(format "$%05d" (string-to-number (match-string 4 a))) "")
|
(if (match-end 5)
|
(concat "@@" (match-string 5 a))))))
|
|
(defun org-table-formula-less-p (a b)
|
"Compare two formulas for sorting."
|
(let ((as (org-table-formula-make-cmp-string (car a)))
|
(bs (org-table-formula-make-cmp-string (car b))))
|
(and as bs (string< as bs))))
|
|
;;;###autoload
|
(defun org-table-get-stored-formulas (&optional noerror location)
|
"Return an alist with the stored formulas directly after current table.
|
By default, only return active formulas, i.e., formulas located
|
on the first line after the table. However, if optional argument
|
LOCATION is a buffer position, consider the formulas there."
|
(save-excursion
|
(if location
|
(progn (goto-char location) (beginning-of-line))
|
(goto-char (org-table-end)))
|
(let ((case-fold-search t))
|
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
|
(let ((strings (org-split-string (match-string-no-properties 2)
|
" *:: *"))
|
eq-alist seen)
|
(dolist (string strings (nreverse eq-alist))
|
(when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|\\$\\([_a-zA-Z0-9]+\\|\
|
[<>]+\\)\\) *= *\\(.*[^ \t]\\)"
|
string)
|
(let ((lhs
|
(let ((m (match-string 1 string)))
|
(cond
|
((not (match-end 2)) m)
|
;; Is it a column reference?
|
((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m)
|
;; Since named columns are not possible in
|
;; LHS, assume this is a named field.
|
(t (match-string 2 string)))))
|
(rhs (match-string 3 string)))
|
(push (cons lhs rhs) eq-alist)
|
(cond
|
((not (member lhs seen)) (push lhs seen))
|
(noerror
|
(message
|
"Double definition `%s=' in TBLFM line, please fix by hand"
|
lhs)
|
(ding)
|
(sit-for 2))
|
(t
|
(user-error
|
"Double definition `%s=' in TBLFM line, please fix by hand"
|
lhs)))))))))))
|
|
(defun org-table-fix-formulas (key replace &optional limit delta remove)
|
"Modify the equations after the table structure has been edited.
|
KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace.
|
For all numbers larger than LIMIT, shift them by DELTA."
|
(save-excursion
|
(goto-char (org-table-end))
|
(while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
|
(let ((msg "The formulas in #+TBLFM have been updated")
|
(re (concat key "\\([0-9]+\\)"))
|
(re2
|
(when remove
|
(if (or (equal key "$") (equal key "$LR"))
|
(format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)"
|
(regexp-quote key) remove)
|
(format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove))))
|
s n a)
|
(when remove
|
(while (re-search-forward re2 (point-at-eol) t)
|
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
|
(if (equal (char-before (match-beginning 0)) ?.)
|
(user-error
|
"Change makes TBLFM term %s invalid, use undo to recover"
|
(match-string 0))
|
(replace-match "")))))
|
(while (re-search-forward re (point-at-eol) t)
|
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
|
(setq s (match-string 1) n (string-to-number s))
|
(cond
|
((setq a (assoc s replace))
|
(replace-match (concat key (cdr a)) t t)
|
(message msg))
|
((and limit (> n limit))
|
(replace-match (concat key (int-to-string (+ n delta))) t t)
|
(message msg))))))
|
(forward-line))))
|
|
;;;###autoload
|
(defun org-table-maybe-eval-formula ()
|
"Check if the current field starts with \"=\" or \":=\".
|
If yes, store the formula and apply it."
|
;; We already know we are in a table. Get field will only return a formula
|
;; when appropriate. It might return a separator line, but no problem.
|
(when org-table-formula-evaluate-inline
|
(let* ((field (org-trim (or (org-table-get-field) "")))
|
named eq)
|
(when (string-match "^:?=\\(.*[^=]\\)$" field)
|
(setq named (equal (string-to-char field) ?:)
|
eq (match-string 1 field))
|
(org-table-eval-formula (and named '(4))
|
(org-table-formula-from-user eq))))))
|
|
(defvar org-recalc-commands nil
|
"List of commands triggering the recalculation of a line.
|
Will be filled automatically during use.")
|
|
(defvar org-recalc-marks
|
'((" " . "Unmarked: no special line, no automatic recalculation")
|
("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
|
("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
|
("!" . "Column name definition line. Reference in formula as $name.")
|
("$" . "Parameter definition line name=value. Reference in formula as $name.")
|
("_" . "Names for values in row below this one.")
|
("^" . "Names for values in row above this one.")))
|
|
;;;###autoload
|
(defun org-table-rotate-recalc-marks (&optional newchar)
|
"Rotate the recalculation mark in the first column.
|
If in any row, the first field is not consistent with a mark,
|
insert a new column for the markers.
|
When there is an active region, change all the lines in the region,
|
after prompting for the marking character.
|
After each change, a message will be displayed indicating the meaning
|
of the new mark."
|
(interactive)
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(let* ((region (org-region-active-p))
|
(l1 (and region
|
(save-excursion (goto-char (region-beginning))
|
(copy-marker (line-beginning-position)))))
|
(l2 (and region
|
(save-excursion (goto-char (region-end))
|
(copy-marker (line-beginning-position)))))
|
(l (copy-marker (line-beginning-position)))
|
(col (org-table-current-column))
|
(newchar (if region
|
(char-to-string
|
(read-char-exclusive
|
"Change region to what mark? Type # * ! $ or SPC: "))
|
newchar))
|
(no-special-column
|
(save-excursion
|
(goto-char (org-table-begin))
|
(re-search-forward
|
"^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" (org-table-end) t))))
|
(when (and newchar (not (assoc newchar org-recalc-marks)))
|
(user-error "Invalid character `%s' in `org-table-rotate-recalc-marks'"
|
newchar))
|
(when l1 (goto-char l1))
|
(save-excursion
|
(beginning-of-line)
|
(unless (looking-at org-table-dataline-regexp)
|
(user-error "Not at a table data line")))
|
(when no-special-column
|
(org-table-goto-column 1)
|
(org-table-insert-column))
|
(let ((previous-line-end (line-end-position))
|
(newchar
|
(save-excursion
|
(beginning-of-line)
|
(cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#")
|
(newchar)
|
(t (cadr (member (match-string 1)
|
(append (mapcar #'car org-recalc-marks)
|
'(" ")))))))))
|
;; Rotate mark in first row.
|
(org-table-get-field 1 (format " %s " newchar))
|
;; Rotate marks in additional rows if a region is active.
|
(when region
|
(save-excursion
|
(forward-line)
|
(while (<= (point) l2)
|
(when (looking-at org-table-dataline-regexp)
|
(org-table-get-field 1 (format " %s " newchar)))
|
(forward-line))))
|
;; Only align if rotation actually changed lines' length.
|
(when (/= previous-line-end (line-end-position)) (org-table-align)))
|
(goto-char l)
|
(org-table-goto-column (if no-special-column (1+ col) col))
|
(when l1 (set-marker l1 nil))
|
(when l2 (set-marker l2 nil))
|
(set-marker l nil)
|
(when (called-interactively-p 'interactive)
|
(message "%s" (cdr (assoc newchar org-recalc-marks))))))
|
|
;;;###autoload
|
(defun org-table-analyze ()
|
"Analyze table at point and store results.
|
|
This function sets up the following dynamically scoped variables:
|
|
`org-table-column-name-regexp',
|
`org-table-column-names',
|
`org-table-current-begin-pos',
|
`org-table-current-line-types',
|
`org-table-current-ncol',
|
`org-table-dlines',
|
`org-table-hlines',
|
`org-table-local-parameters',
|
`org-table-named-field-locations'."
|
(let ((beg (org-table-begin))
|
(end (org-table-end)))
|
(save-excursion
|
(goto-char beg)
|
;; Extract column names.
|
(setq org-table-column-names nil)
|
(when (save-excursion
|
(re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t))
|
(let ((c 1))
|
(dolist (name (org-split-string (match-string 1) " *| *"))
|
(cl-incf c)
|
(when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name)
|
(push (cons name (int-to-string c)) org-table-column-names)))))
|
(setq org-table-column-names (nreverse org-table-column-names))
|
(setq org-table-column-name-regexp
|
(format "\\$\\(%s\\)\\>"
|
(regexp-opt (mapcar #'car org-table-column-names) t)))
|
;; Extract local parameters.
|
(setq org-table-local-parameters nil)
|
(save-excursion
|
(while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
|
(dolist (field (org-split-string (match-string 1) " *| *"))
|
(when (string-match
|
"\\`\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
|
(push (cons (match-string 1 field) (match-string 2 field))
|
org-table-local-parameters)))))
|
;; Update named fields locations. We minimize `count-lines'
|
;; processing by storing last known number of lines in LAST.
|
(setq org-table-named-field-locations nil)
|
(save-excursion
|
(let ((last (cons (point) 0)))
|
(while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
|
(let ((c (match-string 1))
|
(fields (org-split-string (match-string 2) " *| *")))
|
(save-excursion
|
(forward-line (if (equal c "_") 1 -1))
|
(let ((fields1
|
(and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
|
(org-split-string (match-string 1) " *| *")))
|
(line (cl-incf (cdr last) (count-lines (car last) (point))))
|
(col 1))
|
(setcar last (point)) ; Update last known position.
|
(while (and fields fields1)
|
(let ((field (pop fields))
|
(v (pop fields1)))
|
(cl-incf col)
|
(when (and (stringp field)
|
(stringp v)
|
(string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'"
|
field))
|
(push (cons field v) org-table-local-parameters)
|
(push (list field line col)
|
org-table-named-field-locations))))))))))
|
;; Re-use existing markers when possible.
|
(if (markerp org-table-current-begin-pos)
|
(move-marker org-table-current-begin-pos (point))
|
(setq org-table-current-begin-pos (point-marker)))
|
;; Analyze the line types.
|
(let ((l 0) hlines dlines types)
|
(while (looking-at "[ \t]*|\\(-\\)?")
|
(push (if (match-end 1) 'hline 'dline) types)
|
(if (match-end 1) (push l hlines) (push l dlines))
|
(forward-line)
|
(cl-incf l))
|
(push 'hline types) ; Add an imaginary extra hline to the end.
|
(setq org-table-current-line-types (apply #'vector (nreverse types)))
|
(setq org-table-dlines (apply #'vector (cons nil (nreverse dlines))))
|
(setq org-table-hlines (apply #'vector (cons nil (nreverse hlines)))))
|
;; Get the number of columns from the first data line in table.
|
(goto-char beg)
|
(forward-line (aref org-table-dlines 1))
|
(let* ((fields
|
(org-split-string
|
(buffer-substring (line-beginning-position) (line-end-position))
|
"[ \t]*|[ \t]*"))
|
(nfields (length fields))
|
al al2)
|
(setq org-table-current-ncol nfields)
|
(let ((last-dline
|
(aref org-table-dlines (1- (length org-table-dlines)))))
|
(dotimes (i nfields)
|
(let ((column (1+ i)))
|
(push (list (format "LR%d" column) last-dline column) al)
|
(push (cons (format "LR%d" column) (nth i fields)) al2))))
|
(setq org-table-named-field-locations
|
(append org-table-named-field-locations al))
|
(setq org-table-local-parameters
|
(append org-table-local-parameters al2))))))
|
|
(defun org-table-goto-field (ref &optional create-column-p)
|
"Move point to a specific field in the current table.
|
|
REF is either the name of a field its absolute reference, as
|
a string. No column is created unless CREATE-COLUMN-P is
|
non-nil. If it is a function, it is called with the column
|
number as its argument as is used as a predicate to know if the
|
column can be created.
|
|
This function assumes the table is already analyzed (i.e., using
|
`org-table-analyze')."
|
(let* ((coordinates
|
(cond
|
((cdr (assoc ref org-table-named-field-locations)))
|
((string-match "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" ref)
|
(list (condition-case nil
|
(aref org-table-dlines
|
(string-to-number (match-string 1 ref)))
|
(error (user-error "Invalid row number in %s" ref)))
|
(string-to-number (match-string 2 ref))))
|
(t (user-error "Unknown field: %s" ref))))
|
(line (car coordinates))
|
(column (nth 1 coordinates))
|
(create-new-column (if (functionp create-column-p)
|
(funcall create-column-p column)
|
create-column-p)))
|
(when coordinates
|
(goto-char org-table-current-begin-pos)
|
(forward-line line)
|
(org-table-goto-column column nil create-new-column))))
|
|
;;;###autoload
|
(defun org-table-maybe-recalculate-line ()
|
"Recompute the current line if marked for it, and if we haven't just done it."
|
(interactive)
|
(and org-table-allow-automatic-line-recalculation
|
(not (and (memq last-command org-recalc-commands)
|
(eq org-last-recalc-line (line-beginning-position))))
|
(save-excursion (beginning-of-line 1)
|
(looking-at org-table-auto-recalculate-regexp))
|
(org-table-recalculate) t))
|
|
(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula'
|
(defsubst org-set-calc-mode (var &optional value)
|
(if (stringp var)
|
(setq var (assoc var '(("D" calc-angle-mode deg)
|
("R" calc-angle-mode rad)
|
("F" calc-prefer-frac t)
|
("S" calc-symbolic-mode t)))
|
value (nth 2 var) var (nth 1 var)))
|
(if (memq var org-tbl-calc-modes)
|
(setcar (cdr (memq var org-tbl-calc-modes)) value)
|
(cons var (cons value org-tbl-calc-modes)))
|
org-tbl-calc-modes)
|
|
;;;###autoload
|
(defun org-table-eval-formula (&optional arg equation
|
suppress-align suppress-const
|
suppress-store suppress-analysis)
|
"Replace the table field value at the cursor by the result of a calculation.
|
|
In a table, this command replaces the value in the current field with the
|
result of a formula. It also installs the formula as the \"current\" column
|
formula, by storing it in a special line below the table. When called
|
with a `\\[universal-argument]' prefix the formula is installed as a \
|
field formula.
|
|
When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
|
insert the active equation for the field
|
back into the current field, so that it can be edited there. This is \
|
useful
|
in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to \
|
check the referenced fields.
|
|
When called, the command first prompts for a formula, which is read in
|
the minibuffer. Previously entered formulas are available through the
|
history list, and the last used formula is offered as a default.
|
These stored formulas are adapted correctly when moving, inserting, or
|
deleting columns with the corresponding commands.
|
|
The formula can be any algebraic expression understood by the Calc package.
|
For details, see the Org mode manual.
|
|
This function can also be called from Lisp programs and offers
|
additional arguments: EQUATION can be the formula to apply. If this
|
argument is given, the user will not be prompted.
|
|
SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing
|
unnecessary aligns.
|
|
SUPPRESS-CONST suppresses the interpretation of constants in the
|
formula, assuming that this has been done already outside the
|
function.
|
|
SUPPRESS-STORE means the formula should not be stored, either
|
because it is already stored, or because it is a modified
|
equation that should not overwrite the stored one.
|
|
SUPPRESS-ANALYSIS prevents analyzing the table and checking
|
location of point."
|
(interactive "P")
|
(unless suppress-analysis
|
(org-table-check-inside-data-field)
|
(org-table-analyze))
|
(if (equal arg '(16))
|
(let ((eq (org-table-current-field-formula)))
|
(org-table-get-field nil eq)
|
(org-table-align)
|
(setq org-table-may-need-update t))
|
(let* (fields
|
(ndown (if (integerp arg) arg 1))
|
(org-table-automatic-realign nil)
|
(case-fold-search nil)
|
(down (> ndown 1))
|
(formula (if (and equation suppress-store)
|
equation
|
(org-table-get-formula equation (equal arg '(4)))))
|
(n0 (org-table-current-column))
|
(org-tbl-calc-modes (copy-sequence org-calc-default-modes))
|
(numbers nil) ; was a variable, now fixed default
|
(keep-empty nil)
|
n form form0 formrpl formrg bw fmt x ev orig c lispp literal
|
duration duration-output-format)
|
;; Parse the format string. Since we have a lot of modes, this is
|
;; a lot of work. However, I think calc still uses most of the time.
|
(if (string-match ";" formula)
|
(let ((tmp (org-split-string formula ";")))
|
(setq formula (car tmp)
|
fmt (concat (cdr (assoc "%" org-table-local-parameters))
|
(nth 1 tmp)))
|
(while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
|
(setq c (string-to-char (match-string 1 fmt))
|
n (string-to-number (match-string 2 fmt)))
|
(if (= c ?p)
|
(setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n))
|
(setq org-tbl-calc-modes
|
(org-set-calc-mode
|
'calc-float-format
|
(list (cdr (assoc c '((?n . float) (?f . fix)
|
(?s . sci) (?e . eng))))
|
n))))
|
(setq fmt (replace-match "" t t fmt)))
|
(if (string-match "[tTU]" fmt)
|
(let ((ff (match-string 0 fmt)))
|
(setq duration t numbers t
|
duration-output-format
|
(cond ((equal ff "T") nil)
|
((equal ff "t") org-table-duration-custom-format)
|
((equal ff "U") 'hh:mm))
|
fmt (replace-match "" t t fmt))))
|
(if (string-match "N" fmt)
|
(setq numbers t
|
fmt (replace-match "" t t fmt)))
|
(if (string-match "L" fmt)
|
(setq literal t
|
fmt (replace-match "" t t fmt)))
|
(if (string-match "E" fmt)
|
(setq keep-empty t
|
fmt (replace-match "" t t fmt)))
|
(while (string-match "[DRFS]" fmt)
|
(setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt)))
|
(setq fmt (replace-match "" t t fmt)))
|
(unless (string-match "\\S-" fmt)
|
(setq fmt nil))))
|
(when (and (not suppress-const) org-table-formula-use-constants)
|
(setq formula (org-table-formula-substitute-names formula)))
|
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
|
(setq formula (org-table-formula-handle-first/last-rc formula))
|
(while (> ndown 0)
|
(setq fields (org-split-string
|
(org-trim
|
(buffer-substring-no-properties
|
(line-beginning-position) (line-end-position)))
|
" *| *"))
|
;; replace fields with duration values if relevant
|
(if duration
|
(setq fields
|
(mapcar (lambda (x) (org-table-time-string-to-seconds x))
|
fields)))
|
(if (eq numbers t)
|
(setq fields (mapcar
|
(lambda (x)
|
(if (string-match "\\S-" x)
|
(number-to-string (string-to-number x))
|
x))
|
fields)))
|
(setq ndown (1- ndown))
|
(setq form (copy-sequence formula)
|
lispp (and (> (length form) 2) (equal (substring form 0 2) "'(")))
|
(if (and lispp literal) (setq lispp 'literal))
|
|
;; Insert row and column number of formula result field
|
(while (string-match "[@$]#" form)
|
(setq form
|
(replace-match
|
(format "%d"
|
(save-match-data
|
(if (equal (substring form (match-beginning 0)
|
(1+ (match-beginning 0)))
|
"@")
|
(org-table-current-dline)
|
(org-table-current-column))))
|
t t form)))
|
|
;; Check for old vertical references
|
(org-table--error-on-old-row-references form)
|
;; Insert remote references
|
(setq form (org-table-remote-reference-indirection form))
|
(while (string-match "\\<remote([ \t]*\\([^,)]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
|
(setq form
|
(replace-match
|
(save-match-data
|
(org-table-make-reference
|
(let ((rmtrng (org-table-get-remote-range
|
(match-string 1 form) (match-string 2 form))))
|
(if duration
|
(if (listp rmtrng)
|
(mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng)
|
(org-table-time-string-to-seconds rmtrng))
|
rmtrng))
|
keep-empty numbers lispp))
|
t t form)))
|
;; Insert complex ranges
|
(while (and (string-match org-table-range-regexp form)
|
(> (length (match-string 0 form)) 1))
|
(setq formrg
|
(save-match-data
|
(org-table-get-range
|
(match-string 0 form) org-table-current-begin-pos n0)))
|
(setq formrpl
|
(save-match-data
|
(org-table-make-reference
|
;; possibly handle durations
|
(if duration
|
(if (listp formrg)
|
(mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg)
|
(org-table-time-string-to-seconds formrg))
|
formrg)
|
keep-empty numbers lispp)))
|
(if (not (save-match-data
|
(string-match (regexp-quote form) formrpl)))
|
(setq form (replace-match formrpl t t form))
|
(user-error "Spreadsheet error: invalid reference \"%s\"" form)))
|
;; Insert simple ranges, i.e. included in the current row.
|
(while (string-match
|
"\\$\\(\\([-+]\\)?[0-9]+\\)\\.\\.\\$\\(\\([-+]\\)?[0-9]+\\)"
|
form)
|
(setq form
|
(replace-match
|
(save-match-data
|
(org-table-make-reference
|
(cl-subseq fields
|
(+ (if (match-end 2) n0 0)
|
(string-to-number (match-string 1 form))
|
-1)
|
(+ (if (match-end 4) n0 0)
|
(string-to-number (match-string 3 form))))
|
keep-empty numbers lispp))
|
t t form)))
|
(setq form0 form)
|
;; Insert the references to fields in same row
|
(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
|
(setq n (+ (string-to-number (match-string 1 form))
|
(if (match-end 2) n0 0))
|
x (nth (1- (if (= n 0) n0 (max n 1))) fields)
|
formrpl (save-match-data
|
(org-table-make-reference
|
x keep-empty numbers lispp)))
|
(when (or (not x)
|
(save-match-data
|
(string-match (regexp-quote formula) formrpl)))
|
(user-error "Invalid field specifier \"%s\""
|
(match-string 0 form)))
|
(setq form (replace-match formrpl t t form)))
|
|
(if lispp
|
(setq ev (condition-case nil
|
(eval (eval (read form)))
|
(error "#ERROR"))
|
ev (if (numberp ev) (number-to-string ev) ev)
|
ev (if duration (org-table-time-seconds-to-string
|
(string-to-number ev)
|
duration-output-format) ev))
|
|
;; Use <...> time-stamps so that Calc can handle them.
|
(setq form
|
(replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form))
|
;; Internationalize local time-stamps by setting locale to
|
;; "C".
|
(setq form
|
(replace-regexp-in-string
|
org-ts-regexp
|
(lambda (ts)
|
(let ((system-time-locale "C"))
|
(format-time-string
|
(org-time-stamp-format
|
(string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
|
(apply #'encode-time
|
(save-match-data (org-parse-time-string ts))))))
|
form t t))
|
|
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
|
form
|
(calc-eval (cons form org-tbl-calc-modes)
|
(when (and (not keep-empty) numbers) 'num)))
|
ev (if duration (org-table-time-seconds-to-string
|
(if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
|
(string-to-number (org-table-time-string-to-seconds ev))
|
(string-to-number ev))
|
duration-output-format)
|
ev)))
|
|
(when org-table-formula-debug
|
(with-output-to-temp-buffer "*Substitution History*"
|
(princ (format "Substitution history of formula
|
Orig: %s
|
$xyz-> %s
|
@r$c-> %s
|
$1-> %s\n" orig formula form0 form))
|
(if (consp ev)
|
(princ (format " %s^\nError: %s"
|
(make-string (car ev) ?\-) (nth 1 ev)))
|
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
|
ev (or fmt "NONE")
|
(if fmt (format fmt (string-to-number ev)) ev)))))
|
(setq bw (get-buffer-window "*Substitution History*"))
|
(org-fit-window-to-buffer bw)
|
(unless (and (called-interactively-p 'any) (not ndown))
|
(unless (let (inhibit-redisplay)
|
(y-or-n-p "Debugging Formula. Continue to next? "))
|
(org-table-align)
|
(user-error "Abort"))
|
(delete-window bw)
|
(message "")))
|
(when (consp ev) (setq fmt nil ev "#ERROR"))
|
(org-table-justify-field-maybe
|
(format org-table-formula-field-format
|
(cond
|
((not (stringp ev)) ev)
|
(fmt (format fmt (string-to-number ev)))
|
;; Replace any active time stamp in the result with
|
;; an inactive one. Dates in tables are likely
|
;; piece of regular data, not meant to appear in the
|
;; agenda.
|
(t (replace-regexp-in-string org-ts-regexp "[\\1]" ev)))))
|
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
|
(call-interactively 'org-return)
|
(setq ndown 0)))
|
(and down (org-table-maybe-recalculate-line))
|
(or suppress-align (and org-table-may-need-update
|
(org-table-align))))))
|
|
(defun org-table-put-field-property (prop value)
|
(save-excursion
|
(put-text-property (progn (skip-chars-backward "^|") (point))
|
(progn (skip-chars-forward "^|") (point))
|
prop value)))
|
|
(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
|
"Get a calc vector from a column, according to descriptor DESC.
|
|
Optional arguments TBEG and COL can give the beginning of the table and
|
the current column, to avoid unnecessary parsing.
|
|
HIGHLIGHT means just highlight the range.
|
|
When CORNERS-ONLY is set, only return the corners of the range as
|
a list (line1 column1 line2 column2) where line1 and line2 are
|
line numbers relative to beginning of table, or TBEG, and column1
|
and column2 are table column numbers."
|
(let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc)
|
(replace-regexp-in-string "\\$" "@0$" desc)
|
desc))
|
(col (or col (org-table-current-column)))
|
(tbeg (or tbeg (org-table-begin)))
|
(thisline (count-lines tbeg (line-beginning-position))))
|
(unless (string-match org-table-range-regexp desc)
|
(user-error "Invalid table range specifier `%s'" desc))
|
(let ((rangep (match-end 3))
|
(r1 (let ((r (and (match-end 1) (match-string 1 desc))))
|
(or (save-match-data
|
(and (org-string-nw-p r)
|
(org-table--descriptor-line r thisline)))
|
thisline)))
|
(r2 (let ((r (and (match-end 4) (match-string 4 desc))))
|
(or (save-match-data
|
(and (org-string-nw-p r)
|
(org-table--descriptor-line r thisline)))
|
thisline)))
|
(c1 (let ((c (and (match-end 2) (substring (match-string 2 desc) 1))))
|
(if (or (not c) (= (string-to-number c) 0)) col
|
(+ (string-to-number c)
|
(if (memq (string-to-char c) '(?- ?+)) col 0)))))
|
(c2 (let ((c (and (match-end 5) (substring (match-string 5 desc) 1))))
|
(if (or (not c) (= (string-to-number c) 0)) col
|
(+ (string-to-number c)
|
(if (memq (string-to-char c) '(?- ?+)) col 0))))))
|
(save-excursion
|
(if (and (not corners-only)
|
(or (not rangep) (and (= r1 r2) (= c1 c2))))
|
;; Just one field.
|
(progn
|
(forward-line (- r1 thisline))
|
(while (not (looking-at org-table-dataline-regexp))
|
(forward-line))
|
(prog1 (org-trim (org-table-get-field c1))
|
(when highlight (org-table-highlight-rectangle))))
|
;; A range, return a vector. First sort the numbers to get
|
;; a regular rectangle.
|
(let ((first-row (min r1 r2))
|
(last-row (max r1 r2))
|
(first-column (min c1 c2))
|
(last-column (max c1 c2)))
|
(if corners-only (list first-row first-column last-row last-column)
|
;; Copy the range values into a list.
|
(forward-line (- first-row thisline))
|
(while (not (looking-at org-table-dataline-regexp))
|
(forward-line)
|
(cl-incf first-row))
|
(org-table-goto-column first-column)
|
(let ((beg (point)))
|
(forward-line (- last-row first-row))
|
(while (not (looking-at org-table-dataline-regexp))
|
(forward-line -1))
|
(org-table-goto-column last-column)
|
(let ((end (point)))
|
(when highlight
|
(org-table-highlight-rectangle
|
beg (progn (skip-chars-forward "^|\n") (point))))
|
;; Return string representation of calc vector.
|
(mapcar #'org-trim
|
(apply #'append
|
(org-table-copy-region beg end))))))))))))
|
|
(defun org-table--descriptor-line (desc cline)
|
"Return relative line number corresponding to descriptor DESC.
|
The cursor is currently in relative line number CLINE."
|
(if (string-match "\\`[0-9]+\\'" desc)
|
(aref org-table-dlines (string-to-number desc))
|
(when (or (not (string-match
|
"^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?"
|
;; 1 2 3 4 5 6
|
desc))
|
(and (not (match-end 3)) (not (match-end 6)))
|
(and (match-end 3) (match-end 6) (not (match-end 5))))
|
(user-error "Invalid row descriptor `%s'" desc))
|
(let* ((hn (and (match-end 3) (- (match-end 3) (match-beginning 3))))
|
(hdir (match-string 2 desc))
|
(odir (match-string 5 desc))
|
(on (and (match-end 6) (string-to-number (match-string 6 desc))))
|
(rel (and (match-end 6)
|
(or (and (match-end 1) (not (match-end 3)))
|
(match-end 5)))))
|
(when (and hn (not hdir))
|
(setq cline 0)
|
(setq hdir "+")
|
(when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn)))
|
(when (and (not hn) on (not odir)) (user-error "Should never happen"))
|
(when hn
|
(setq cline
|
(org-table--row-type 'hline hn cline (equal hdir "-") nil desc)))
|
(when on
|
(setq cline
|
(org-table--row-type 'dline on cline (equal odir "-") rel desc)))
|
cline)))
|
|
(defun org-table--row-type (type n i backwards relative desc)
|
"Return relative line of Nth row with type TYPE.
|
Search starts from relative line I. When BACKWARDS in non-nil,
|
look before I. When RELATIVE is non-nil, the reference is
|
relative. DESC is the original descriptor that started the
|
search, as a string."
|
(let ((l (length org-table-current-line-types)))
|
(catch :exit
|
(dotimes (_ n)
|
(while (and (cl-incf i (if backwards -1 1))
|
(>= i 0)
|
(< i l)
|
(not (eq (aref org-table-current-line-types i) type))
|
;; We are going to cross a hline. Check if this is
|
;; an authorized move.
|
(cond
|
((not relative))
|
((not (eq (aref org-table-current-line-types i) 'hline)))
|
((eq org-table-relative-ref-may-cross-hline t))
|
((eq org-table-relative-ref-may-cross-hline 'error)
|
(user-error "Row descriptor %s crosses hline" desc))
|
(t (cl-decf i (if backwards -1 1)) ; Step back.
|
(throw :exit nil)))))))
|
(cond ((or (< i 0) (>= i l))
|
(user-error "Row descriptor %s leads outside table" desc))
|
;; The last hline doesn't exist. Instead, point to last row
|
;; in table.
|
((= i (1- l)) (1- i))
|
(t i))))
|
|
(defun org-table--error-on-old-row-references (s)
|
(when (string-match "&[-+0-9I]" s)
|
(user-error "Formula contains old &row reference, please rewrite using @-syntax")))
|
|
(defun org-table-make-reference (elements keep-empty numbers lispp)
|
"Convert list ELEMENTS to something appropriate to insert into formula.
|
KEEP-EMPTY indicated to keep empty fields, default is to skip them.
|
NUMBERS indicates that everything should be converted to numbers.
|
LISPP non-nil means to return something appropriate for a Lisp
|
list, `literal' is for the format specifier L."
|
;; Calc nan (not a number) is used for the conversion of the empty
|
;; field to a reference for several reasons: (i) It is accepted in a
|
;; Calc formula (e. g. "" or "()" would result in a Calc error).
|
;; (ii) In a single field (not in range) it can be distinguished
|
;; from "(nan)" which is the reference made from a single field
|
;; containing "nan".
|
(if (stringp elements)
|
;; field reference
|
(if lispp
|
(if (eq lispp 'literal)
|
elements
|
(if (and (eq elements "") (not keep-empty))
|
""
|
(prin1-to-string
|
(if numbers (string-to-number elements) elements))))
|
(if (string-match "\\S-" elements)
|
(progn
|
(when numbers (setq elements (number-to-string
|
(string-to-number elements))))
|
(concat "(" elements ")"))
|
(if (or (not keep-empty) numbers) "(0)" "nan")))
|
;; range reference
|
(unless keep-empty
|
(setq elements
|
(delq nil
|
(mapcar (lambda (x) (if (string-match "\\S-" x) x nil))
|
elements))))
|
(setq elements (or elements '())) ; if delq returns nil then we need '()
|
(if lispp
|
(mapconcat
|
(lambda (x)
|
(if (eq lispp 'literal)
|
x
|
(prin1-to-string (if numbers (string-to-number x) x))))
|
elements " ")
|
(concat "[" (mapconcat
|
(lambda (x)
|
(if (string-match "\\S-" x)
|
(if numbers
|
(number-to-string (string-to-number x))
|
x)
|
(if (or (not keep-empty) numbers) "0" "nan")))
|
elements
|
",") "]"))))
|
|
(defun org-table-message-once-per-second (t1 &rest args)
|
"If there has been more than one second since T1, display message.
|
ARGS are passed as arguments to the `message' function. Returns
|
current time if a message is printed, otherwise returns T1. If
|
T1 is nil, always messages."
|
(let ((curtime (current-time)))
|
(if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1))))
|
(progn (apply 'message args)
|
curtime)
|
t1)))
|
|
;;;###autoload
|
(defun org-table-recalculate (&optional all noalign)
|
"Recalculate the current table line by applying all stored formulas.
|
|
With prefix arg ALL, do this for all lines in the table.
|
|
When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \
|
if ALL is the symbol `iterate',
|
recompute the table until it no longer changes.
|
|
If NOALIGN is not nil, do not re-align the table after the computations
|
are done. This is typically used internally to save time, if it is
|
known that the table will be realigned a little later anyway."
|
(interactive "P")
|
(unless (memq this-command org-recalc-commands)
|
(push this-command org-recalc-commands))
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
(if (or (eq all 'iterate) (equal all '(16)))
|
(org-table-iterate)
|
(org-table-analyze)
|
(let* ((eqlist (sort (org-table-get-stored-formulas)
|
(lambda (a b) (string< (car a) (car b)))))
|
(inhibit-redisplay (not debug-on-error))
|
(line-re org-table-dataline-regexp)
|
(log-first-time (current-time))
|
(log-last-time log-first-time)
|
(cnt 0)
|
beg end eqlcol eqlfield)
|
;; Insert constants in all formulas.
|
(when eqlist
|
(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 markers and internal text property.
|
(remove-text-properties (point-min) (point-max) '(org-untouchable t))
|
(set-marker end nil)
|
(unless noalign
|
(when org-table-may-need-update (org-table-align))
|
(when all
|
(org-table-message-once-per-second
|
log-first-time "Re-applying formulas to %d lines... done" cnt)))
|
(org-table-message-once-per-second
|
(and all log-first-time) "Re-applying formulas... done")))))
|
|
;;;###autoload
|
(defun org-table-iterate (&optional arg)
|
"Recalculate the table until it does not change anymore.
|
The maximum number of iterations is 10, but you can choose a different value
|
with the prefix ARG."
|
(interactive "P")
|
(let ((imax (if arg (prefix-numeric-value arg) 10))
|
(i 0)
|
(lasttbl (buffer-substring (org-table-begin) (org-table-end)))
|
thistbl)
|
(catch 'exit
|
(while (< i imax)
|
(setq i (1+ i))
|
(org-table-recalculate 'all)
|
(setq thistbl (buffer-substring (org-table-begin) (org-table-end)))
|
(if (not (string= lasttbl thistbl))
|
(setq lasttbl thistbl)
|
(if (> i 1)
|
(message "Convergence after %d iterations" i)
|
(message "Table was already stable"))
|
(throw 'exit t)))
|
(user-error "No convergence after %d iterations" i))))
|
|
;;;###autoload
|
(defun org-table-recalculate-buffer-tables ()
|
"Recalculate all tables in the current buffer."
|
(interactive)
|
(org-with-wide-buffer
|
(org-table-map-tables
|
(lambda ()
|
;; Reason for separate `org-table-align': When repeating
|
;; (org-table-recalculate t) `org-table-may-need-update' gets in
|
;; the way.
|
(org-table-recalculate t t)
|
(org-table-align))
|
t)))
|
|
;;;###autoload
|
(defun org-table-iterate-buffer-tables ()
|
"Iterate all tables in the buffer, to converge inter-table dependencies."
|
(interactive)
|
(let* ((imax 10)
|
(i imax)
|
(checksum (md5 (buffer-string)))
|
c1)
|
(org-with-wide-buffer
|
(catch 'exit
|
(while (> i 0)
|
(setq i (1- i))
|
(org-table-map-tables (lambda () (org-table-recalculate t t)) t)
|
(if (equal checksum (setq c1 (md5 (buffer-string))))
|
(progn
|
(org-table-map-tables #'org-table-align t)
|
(message "Convergence after %d iterations" (- imax i))
|
(throw 'exit t))
|
(setq checksum c1)))
|
(org-table-map-tables #'org-table-align t)
|
(user-error "No convergence after %d iterations" imax)))))
|
|
(defun org-table-calc-current-TBLFM (&optional arg)
|
"Apply the #+TBLFM in the line at point to the table."
|
(interactive "P")
|
(unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line"))
|
(let ((formula (buffer-substring
|
(line-beginning-position)
|
(line-end-position))))
|
(save-excursion
|
;; Insert a temporary formula at right after the table
|
(goto-char (org-table-TBLFM-begin))
|
(let ((s (point-marker)))
|
(insert formula "\n")
|
(let ((e (point-marker)))
|
;; Recalculate the table.
|
(beginning-of-line 0) ; move to the inserted line
|
(skip-chars-backward " \r\n\t")
|
(unwind-protect
|
(org-call-with-arg #'org-table-recalculate (or arg t))
|
;; Delete the formula inserted temporarily.
|
(delete-region s e)
|
(set-marker s nil)
|
(set-marker e nil)))))))
|
|
(defun org-table-TBLFM-begin ()
|
"Find the beginning of the TBLFM lines and return its position.
|
Return nil when the beginning of TBLFM line was not found."
|
(save-excursion
|
(when (progn (forward-line 1)
|
(re-search-backward org-table-TBLFM-begin-regexp nil t))
|
(line-beginning-position 2))))
|
|
(defun org-table-expand-lhs-ranges (equations)
|
"Expand list of formulas.
|
If some of the RHS in the formulas are ranges or a row reference,
|
expand them to individual field equations for each field. This
|
function assumes the table is already analyzed (i.e., using
|
`org-table-analyze')."
|
(let (res)
|
(dolist (e equations (nreverse res))
|
(let ((lhs (car e))
|
(rhs (cdr e)))
|
(cond
|
((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
|
;; This just refers to one fixed field.
|
(push e res))
|
((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
|
;; This just refers to one fixed named field.
|
(push e res))
|
((string-match-p "\\`\\$[0-9]+\\'" lhs)
|
;; Column formulas are treated specially and are not
|
;; expanded.
|
(push e res))
|
((string-match "\\`@[0-9]+\\'" lhs)
|
(dotimes (ic org-table-current-ncol)
|
(push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e)
|
rhs)
|
res)))
|
(t
|
(let* ((range (org-table-get-range
|
lhs org-table-current-begin-pos 1 nil 'corners))
|
(r1 (org-table-line-to-dline (nth 0 range)))
|
(c1 (nth 1 range))
|
(r2 (org-table-line-to-dline (nth 2 range) 'above))
|
(c2 (nth 3 range)))
|
(cl-loop for ir from r1 to r2 do
|
(cl-loop for ic from c1 to c2 do
|
(push (cons (propertize
|
(format "@%d$%d" ir ic) :orig-eqn e)
|
rhs)
|
res))))))))))
|
|
(defun org-table-formula-handle-first/last-rc (s)
|
"Replace @<, @>, $<, $> with first/last row/column of the table.
|
So @< and $< will always be replaced with @1 and $1, respectively.
|
The advantage of these special markers are that structure editing of
|
the table will not change them, while @1 and $1 will be modified
|
when a line/row is swapped out of that privileged position. So for
|
formulas that use a range of rows or columns, it may often be better
|
to anchor the formula with \"I\" row markers, or to offset from the
|
borders of the table using the @< @> $< $> makers."
|
(let (n nmax len char (start 0))
|
(while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^)]+)\\)"
|
s start)
|
(if (match-end 3)
|
(setq start (match-end 3))
|
(setq nmax (if (equal (match-string 1 s) "@")
|
(1- (length org-table-dlines))
|
org-table-current-ncol)
|
len (- (match-end 2) (match-beginning 2))
|
char (string-to-char (match-string 2 s))
|
n (if (= char ?<)
|
len
|
(- nmax len -1)))
|
(if (or (< n 1) (> n nmax))
|
(user-error "Reference \"%s\" in expression \"%s\" points outside table"
|
(match-string 0 s) s))
|
(setq start (match-beginning 0))
|
(setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
|
s)
|
|
(defun org-table-formula-substitute-names (f)
|
"Replace $const with values in string F."
|
(let ((start 0)
|
(pp (/= (string-to-char f) ?'))
|
(duration (string-match-p ";.*[Tt].*\\'" f))
|
(new (replace-regexp-in-string ; Check for column names.
|
org-table-column-name-regexp
|
(lambda (m)
|
(concat "$" (cdr (assoc (match-string 1 m)
|
org-table-column-names))))
|
f t t)))
|
;; Parameters and constants.
|
(while (setq start
|
(string-match
|
"\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)"
|
new start))
|
(if (match-end 2) (setq start (match-end 2))
|
(cl-incf start)
|
;; When a duration is expected, convert value on the fly.
|
(let ((value
|
(save-match-data
|
(let ((v (org-table-get-constant (match-string 1 new))))
|
(if (and (org-string-nw-p v) duration)
|
(org-table-time-string-to-seconds v)
|
v)))))
|
(when value
|
(setq new (replace-match
|
(concat (and pp "(") value (and pp ")")) t t new))))))
|
(if org-table-formula-debug (propertize new :orig-formula f) new)))
|
|
(defun org-table-get-constant (const)
|
"Find the value for a parameter or constant in a formula.
|
Parameters get priority."
|
(or (cdr (assoc const org-table-local-parameters))
|
(cdr (assoc const org-table-formula-constants-local))
|
(cdr (assoc const org-table-formula-constants))
|
(and (fboundp 'constants-get) (constants-get const))
|
(and (string= (substring const 0 (min 5 (length const))) "PROP_")
|
(org-entry-get nil (substring const 5) 'inherit))
|
"#UNDEFINED_NAME"))
|
|
(defvar org-table-fedit-map
|
(let ((map (make-sparse-keymap)))
|
(org-defkey map "\C-x\C-s" 'org-table-fedit-finish)
|
(org-defkey map "\C-c\C-s" 'org-table-fedit-finish)
|
(org-defkey map "\C-c\C-c" 'org-table-fedit-finish)
|
(org-defkey map "\C-c'" 'org-table-fedit-finish)
|
(org-defkey map "\C-c\C-q" 'org-table-fedit-abort)
|
(org-defkey map "\C-c?" 'org-table-show-reference)
|
(org-defkey map [(meta shift up)] 'org-table-fedit-line-up)
|
(org-defkey map [(meta shift down)] 'org-table-fedit-line-down)
|
(org-defkey map [(shift up)] 'org-table-fedit-ref-up)
|
(org-defkey map [(shift down)] 'org-table-fedit-ref-down)
|
(org-defkey map [(shift left)] 'org-table-fedit-ref-left)
|
(org-defkey map [(shift right)] 'org-table-fedit-ref-right)
|
(org-defkey map [(meta up)] 'org-table-fedit-scroll-down)
|
(org-defkey map [(meta down)] 'org-table-fedit-scroll)
|
(org-defkey map [(meta tab)] 'lisp-complete-symbol)
|
(org-defkey map "\M-\C-i" 'lisp-complete-symbol)
|
(org-defkey map [(tab)] 'org-table-fedit-lisp-indent)
|
(org-defkey map "\C-i" 'org-table-fedit-lisp-indent)
|
(org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
|
(org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates)
|
map))
|
|
(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
|
'("Edit-Formulas"
|
["Finish and Install" org-table-fedit-finish t]
|
["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"]
|
["Abort" org-table-fedit-abort t]
|
"--"
|
["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t]
|
["Complete Lisp Symbol" lisp-complete-symbol t]
|
"--"
|
"Shift Reference at Point"
|
["Up" org-table-fedit-ref-up t]
|
["Down" org-table-fedit-ref-down t]
|
["Left" org-table-fedit-ref-left t]
|
["Right" org-table-fedit-ref-right t]
|
"-"
|
"Change Test Row for Column Formulas"
|
["Up" org-table-fedit-line-up t]
|
["Down" org-table-fedit-line-down t]
|
"--"
|
["Scroll Table Window" org-table-fedit-scroll t]
|
["Scroll Table Window down" org-table-fedit-scroll-down t]
|
["Show Table Grid" org-table-fedit-toggle-coordinates
|
:style toggle :selected (with-current-buffer (marker-buffer org-pos)
|
org-table-overlay-coordinates)]
|
"--"
|
["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type
|
:style toggle :selected org-table-buffer-is-an]))
|
|
(defvar org-pos)
|
(defvar org-table--fedit-source nil
|
"Position of the TBLFM line being edited.")
|
|
;;;###autoload
|
(defun org-table-edit-formulas ()
|
"Edit the formulas of the current table in a separate buffer."
|
(interactive)
|
(let ((at-tblfm (org-at-TBLFM-p)))
|
(unless (or at-tblfm (org-at-table-p))
|
(user-error "Not at a table"))
|
(save-excursion
|
;; Move point within the table before analyzing it.
|
(when at-tblfm (re-search-backward "^[ \t]*|"))
|
(org-table-analyze))
|
(let ((key (org-table-current-field-formula 'key 'noerror))
|
(eql (sort (org-table-get-stored-formulas t (and at-tblfm (point)))
|
#'org-table-formula-less-p))
|
(pos (point-marker))
|
(source (copy-marker (line-beginning-position)))
|
(startline 1)
|
(wc (current-window-configuration))
|
(sel-win (selected-window))
|
(titles '((column . "# Column Formulas\n")
|
(field . "# Field and Range Formulas\n")
|
(named . "# Named Field Formulas\n"))))
|
(org-switch-to-buffer-other-window "*Edit Formulas*")
|
(erase-buffer)
|
;; Keep global-font-lock-mode from turning on font-lock-mode
|
(let ((font-lock-global-modes '(not fundamental-mode)))
|
(fundamental-mode))
|
(setq-local font-lock-global-modes (list 'not major-mode))
|
(setq-local org-pos pos)
|
(setq-local org-table--fedit-source source)
|
(setq-local org-window-configuration wc)
|
(setq-local org-selected-window sel-win)
|
(use-local-map org-table-fedit-map)
|
(add-hook 'post-command-hook #'org-table-fedit-post-command t t)
|
(easy-menu-add org-table-fedit-menu)
|
(setq startline (org-current-line))
|
(dolist (entry eql)
|
(let* ((type (cond
|
((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry))
|
'column)
|
((equal (string-to-char (car entry)) ?@) 'field)
|
(t 'named)))
|
(title (assq type titles)))
|
(when title
|
(unless (bobp) (insert "\n"))
|
(insert
|
(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
|
(if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$")
|
(car entry) " = " (cdr entry) "\n")))
|
(remove-text-properties 0 (length s) '(face nil) s)
|
(insert s))))
|
(when (eq org-table-use-standard-references t)
|
(org-table-fedit-toggle-ref-type))
|
(org-goto-line startline)
|
(message "%s" (substitute-command-keys "\\<org-mode-map>\
|
Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \
|
See menu for more commands.")))))
|
|
(defun org-table-fedit-post-command ()
|
(when (not (memq this-command '(lisp-complete-symbol)))
|
(let ((win (selected-window)))
|
(save-excursion
|
(ignore-errors (org-table-show-reference))
|
(select-window win)))))
|
|
(defun org-table-formula-to-user (s)
|
"Convert a formula from internal to user representation."
|
(if (eq org-table-use-standard-references t)
|
(org-table-convert-refs-to-an s)
|
s))
|
|
(defun org-table-formula-from-user (s)
|
"Convert a formula from user to internal representation."
|
(if org-table-use-standard-references
|
(org-table-convert-refs-to-rc s)
|
s))
|
|
(defun org-table-convert-refs-to-rc (s)
|
"Convert spreadsheet references from A7 to @7$28.
|
Works for single references, but also for entire formulas and even the
|
full TBLFM line."
|
(let ((start 0))
|
(while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start)
|
(cond
|
((match-end 3)
|
;; format match, just advance
|
(setq start (match-end 0)))
|
((and (> (match-beginning 0) 0)
|
(equal ?. (aref s (max (1- (match-beginning 0)) 0)))
|
(not (equal ?. (aref s (max (- (match-beginning 0) 2) 0)))))
|
;; 3.e5 or something like this.
|
(setq start (match-end 0)))
|
((or (> (- (match-end 1) (match-beginning 1)) 2)
|
;; (member (match-string 1 s)
|
;; '("arctan" "exp" "expm" "lnp" "log" "stir"))
|
)
|
;; function name, just advance
|
(setq start (match-end 0)))
|
(t
|
(setq start (match-beginning 0)
|
s (replace-match
|
(if (equal (match-string 2 s) "&")
|
(format "$%d" (org-letters-to-number (match-string 1 s)))
|
(format "@%d$%d"
|
(string-to-number (match-string 2 s))
|
(org-letters-to-number (match-string 1 s))))
|
t t s)))))
|
s))
|
|
(defun org-table-convert-refs-to-an (s)
|
"Convert spreadsheet references from to @7$28 to AB7.
|
Works for single references, but also for entire formulas and even the
|
full TBLFM line."
|
(while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s)
|
(setq s (replace-match
|
(format "%s%d"
|
(org-number-to-letters
|
(string-to-number (match-string 2 s)))
|
(string-to-number (match-string 1 s)))
|
t t s)))
|
(while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s)
|
(setq s (replace-match (concat "\\1"
|
(org-number-to-letters
|
(string-to-number (match-string 2 s))) "&")
|
t nil s)))
|
s)
|
|
(defun org-letters-to-number (s)
|
"Convert a base 26 number represented by letters into an integer.
|
For example: AB -> 28."
|
(let ((n 0))
|
(setq s (upcase s))
|
(while (> (length s) 0)
|
(setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
|
s (substring s 1)))
|
n))
|
|
(defun org-number-to-letters (n)
|
"Convert an integer into a base 26 number represented by letters.
|
For example: 28 -> AB."
|
(let ((s ""))
|
(while (> n 0)
|
(setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s)
|
n (/ (1- n) 26)))
|
s))
|
|
(defun org-table-time-string-to-seconds (s)
|
"Convert a time string into numerical duration in seconds.
|
S can be a string matching either -?HH:MM:SS or -?HH:MM.
|
If S is a string representing a number, keep this number."
|
(if (equal s "")
|
s
|
(let (hour minus min sec res)
|
(cond
|
((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
|
(setq minus (< 0 (length (match-string 1 s)))
|
hour (string-to-number (match-string 2 s))
|
min (string-to-number (match-string 3 s))
|
sec (string-to-number (match-string 4 s)))
|
(if minus
|
(setq res (- (+ (* hour 3600) (* min 60) sec)))
|
(setq res (+ (* hour 3600) (* min 60) sec))))
|
((and (not (string-match org-ts-regexp-both s))
|
(string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
|
(setq minus (< 0 (length (match-string 1 s)))
|
hour (string-to-number (match-string 2 s))
|
min (string-to-number (match-string 3 s)))
|
(if minus
|
(setq res (- (+ (* hour 3600) (* min 60))))
|
(setq res (+ (* hour 3600) (* min 60)))))
|
(t (setq res (string-to-number s))))
|
(number-to-string res))))
|
|
(defun org-table-time-seconds-to-string (secs &optional output-format)
|
"Convert a number of seconds to a time string.
|
If OUTPUT-FORMAT is non-nil, return a number of days, hours,
|
minutes or seconds."
|
(let* ((secs0 (abs secs))
|
(res
|
(cond ((eq output-format 'days)
|
(format "%.3f" (/ (float secs0) 86400)))
|
((eq output-format 'hours)
|
(format "%.2f" (/ (float secs0) 3600)))
|
((eq output-format 'minutes)
|
(format "%.1f" (/ (float secs0) 60)))
|
((eq output-format 'seconds)
|
(format "%d" secs0))
|
((eq output-format 'hh:mm)
|
;; Ignore seconds
|
(substring (format-seconds
|
(if org-table-duration-hour-zero-padding
|
"%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
|
secs0)
|
0 -3))
|
(t (format-seconds
|
(if org-table-duration-hour-zero-padding
|
"%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
|
secs0)))))
|
(if (< secs 0) (concat "-" res) res)))
|
|
(defun org-table-fedit-convert-buffer (function)
|
"Convert all references in this buffer, using FUNCTION."
|
(let ((origin (copy-marker (line-beginning-position))))
|
(goto-char (point-min))
|
(while (not (eobp))
|
(insert (funcall function (buffer-substring (point) (line-end-position))))
|
(delete-region (point) (line-end-position))
|
(forward-line))
|
(goto-char origin)
|
(set-marker origin nil)))
|
|
(defun org-table-fedit-toggle-ref-type ()
|
"Convert all references in the buffer from B3 to @3$2 and back."
|
(interactive)
|
(setq-local org-table-buffer-is-an (not org-table-buffer-is-an))
|
(org-table-fedit-convert-buffer
|
(if org-table-buffer-is-an
|
'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
|
(message "Reference type switched to %s"
|
(if org-table-buffer-is-an "A1 etc" "@row$column")))
|
|
(defun org-table-fedit-ref-up ()
|
"Shift the reference at point one row/hline up."
|
(interactive)
|
(org-table-fedit-shift-reference 'up))
|
(defun org-table-fedit-ref-down ()
|
"Shift the reference at point one row/hline down."
|
(interactive)
|
(org-table-fedit-shift-reference 'down))
|
(defun org-table-fedit-ref-left ()
|
"Shift the reference at point one field to the left."
|
(interactive)
|
(org-table-fedit-shift-reference 'left))
|
(defun org-table-fedit-ref-right ()
|
"Shift the reference at point one field to the right."
|
(interactive)
|
(org-table-fedit-shift-reference 'right))
|
|
(defun org-table-fedit-shift-reference (dir)
|
(cond
|
((org-in-regexp "\\(\\<[a-zA-Z]\\)&")
|
(if (memq dir '(left right))
|
(org-rematch-and-replace 1 (eq dir 'left))
|
(user-error "Cannot shift reference in this direction")))
|
((org-in-regexp "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
|
;; A B3-like reference
|
(if (memq dir '(up down))
|
(org-rematch-and-replace 2 (eq dir 'up))
|
(org-rematch-and-replace 1 (eq dir 'left))))
|
((org-in-regexp
|
"\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?")
|
;; An internal reference
|
(if (memq dir '(up down))
|
(org-rematch-and-replace 2 (eq dir 'up) (match-end 3))
|
(org-rematch-and-replace 5 (eq dir 'left))))))
|
|
(defun org-rematch-and-replace (n &optional decr hline)
|
"Re-match the group N, and replace it with the shifted reference."
|
(or (match-end n) (user-error "Cannot shift reference in this direction"))
|
(goto-char (match-beginning n))
|
(and (looking-at (regexp-quote (match-string n)))
|
(replace-match (org-table-shift-refpart (match-string 0) decr hline)
|
t t)))
|
|
(defun org-table-shift-refpart (ref &optional decr hline)
|
"Shift a reference part REF.
|
If DECR is set, decrease the references row/column, else increase.
|
If HLINE is set, this may be a hline reference, it certainly is not
|
a translation reference."
|
(save-match-data
|
(let* ((sign (string-match "^[-+]" ref)) n)
|
|
(if sign (setq sign (substring ref 0 1) ref (substring ref 1)))
|
(cond
|
((and hline (string-match "^I+" ref))
|
(setq n (string-to-number (concat sign (number-to-string (length ref)))))
|
(setq n (+ n (if decr -1 1)))
|
(if (= n 0) (setq n (+ n (if decr -1 1))))
|
(if sign
|
(setq sign (if (< n 0) "-" "+") n (abs n))
|
(setq n (max 1 n)))
|
(concat sign (make-string n ?I)))
|
|
((string-match "^[0-9]+" ref)
|
(setq n (string-to-number (concat sign ref)))
|
(setq n (+ n (if decr -1 1)))
|
(if sign
|
(concat (if (< n 0) "-" "+") (number-to-string (abs n)))
|
(number-to-string (max 1 n))))
|
|
((string-match "^[a-zA-Z]+" ref)
|
(org-number-to-letters
|
(max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
|
|
(t (user-error "Cannot shift reference"))))))
|
|
(defun org-table-fedit-toggle-coordinates ()
|
"Toggle the display of coordinates in the referenced table."
|
(interactive)
|
(let ((pos (marker-position org-pos)))
|
(with-current-buffer (marker-buffer org-pos)
|
(save-excursion
|
(goto-char pos)
|
(org-table-toggle-coordinate-overlays)))))
|
|
(defun org-table-fedit-finish (&optional arg)
|
"Parse the buffer for formula definitions and install them.
|
With prefix ARG, apply the new formulas to the table."
|
(interactive "P")
|
(org-table-remove-rectangle-highlight)
|
(when org-table-use-standard-references
|
(org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
|
(setq org-table-buffer-is-an nil))
|
(let ((pos org-pos)
|
(sel-win org-selected-window)
|
(source org-table--fedit-source)
|
eql)
|
(goto-char (point-min))
|
(while (re-search-forward
|
"^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
|
nil t)
|
(let ((var (match-string 1))
|
(form (org-trim (match-string 3))))
|
(unless (equal form "")
|
(while (string-match "[ \t]*\n[ \t]*" form)
|
(setq form (replace-match " " t t form)))
|
(when (assoc var eql)
|
(user-error "Double formulas for %s" var))
|
(push (cons var form) eql))))
|
(set-window-configuration org-window-configuration)
|
(select-window sel-win)
|
(goto-char source)
|
(org-table-store-formulas eql)
|
(set-marker pos nil)
|
(set-marker source nil)
|
(kill-buffer "*Edit Formulas*")
|
(if arg
|
(org-table-recalculate 'all)
|
(message "New formulas installed - press C-u C-c C-c to apply."))))
|
|
(defun org-table-fedit-abort ()
|
"Abort editing formulas, without installing the changes."
|
(interactive)
|
(org-table-remove-rectangle-highlight)
|
(let ((pos org-pos) (sel-win org-selected-window))
|
(set-window-configuration org-window-configuration)
|
(select-window sel-win)
|
(goto-char pos)
|
(move-marker pos nil)
|
(message "Formula editing aborted without installing changes")))
|
|
(defun org-table-fedit-lisp-indent ()
|
"Pretty-print and re-indent Lisp expressions in the Formula Editor."
|
(interactive)
|
(let ((pos (point)) beg end ind)
|
(beginning-of-line 1)
|
(cond
|
((looking-at "[ \t]")
|
(goto-char pos)
|
(call-interactively 'lisp-indent-line))
|
((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
|
((not (fboundp 'pp-buffer))
|
(user-error "Cannot pretty-print. Command `pp-buffer' is not available"))
|
((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
|
(goto-char (- (match-end 0) 2))
|
(setq beg (point))
|
(setq ind (make-string (current-column) ?\ ))
|
(condition-case nil (forward-sexp 1)
|
(error
|
(user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
|
(setq end (point))
|
(save-restriction
|
(narrow-to-region beg end)
|
(if (eq last-command this-command)
|
(progn
|
(goto-char (point-min))
|
(setq this-command nil)
|
(while (re-search-forward "[ \t]*\n[ \t]*" nil t)
|
(replace-match " ")))
|
(pp-buffer)
|
(untabify (point-min) (point-max))
|
(goto-char (1+ (point-min)))
|
(while (re-search-forward "^." nil t)
|
(beginning-of-line 1)
|
(insert ind))
|
(goto-char (point-max))
|
(org-delete-backward-char 1)))
|
(goto-char beg))
|
(t nil))))
|
|
(defvar org-show-positions nil)
|
|
(defun org-table-show-reference (&optional local)
|
"Show the location/value of the $ expression at point.
|
When LOCAL is non-nil, show references for the table at point."
|
(interactive)
|
(org-table-remove-rectangle-highlight)
|
(when local (org-table-analyze))
|
(catch 'exit
|
(let ((pos (if local (point) org-pos))
|
(face2 'highlight)
|
(org-inhibit-highlight-removal t)
|
(win (selected-window))
|
(org-show-positions nil)
|
var name e what match dest)
|
(setq what (cond
|
((org-in-regexp "^@[0-9]+[ \t=]")
|
(setq match (concat (substring (match-string 0) 0 -1)
|
"$1.."
|
(substring (match-string 0) 0 -1)
|
"$100"))
|
'range)
|
((or (org-in-regexp org-table-range-regexp2)
|
(org-in-regexp org-table-translate-regexp)
|
(org-in-regexp org-table-range-regexp))
|
(setq match
|
(save-match-data
|
(org-table-convert-refs-to-rc (match-string 0))))
|
'range)
|
((org-in-regexp "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
|
((org-in-regexp "\\$[0-9]+") 'column)
|
((not local) nil)
|
(t (user-error "No reference at point")))
|
match (and what (or match (match-string 0))))
|
(when (and match (not (equal (match-beginning 0) (point-at-bol))))
|
(org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
|
'secondary-selection))
|
(add-hook 'before-change-functions
|
#'org-table-remove-rectangle-highlight)
|
(when (eq what 'name) (setq var (substring match 1)))
|
(when (eq what 'range)
|
(unless (eq (string-to-char match) ?@) (setq match (concat "@" match)))
|
(setq match (org-table-formula-substitute-names match)))
|
(unless local
|
(save-excursion
|
(end-of-line)
|
(re-search-backward "^\\S-" nil t)
|
(beginning-of-line)
|
(when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\
|
\\([0-9]+\\|&\\)\\) *=")
|
(setq dest
|
(save-match-data
|
(org-table-convert-refs-to-rc (match-string 1))))
|
(org-table-add-rectangle-overlay
|
(match-beginning 1) (match-end 1) face2))))
|
(if (and (markerp pos) (marker-buffer pos))
|
(if (get-buffer-window (marker-buffer pos))
|
(select-window (get-buffer-window (marker-buffer pos)))
|
(org-switch-to-buffer-other-window (get-buffer-window
|
(marker-buffer pos)))))
|
(goto-char pos)
|
(org-table-force-dataline)
|
(let ((table-start
|
(if local org-table-current-begin-pos (org-table-begin))))
|
(when dest
|
(setq name (substring dest 1))
|
(cond
|
((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest)
|
(org-table-goto-field dest))
|
((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'"
|
dest)
|
(org-table-goto-field dest))
|
(t (org-table-goto-column (string-to-number name))))
|
(move-marker pos (point))
|
(org-table-highlight-rectangle nil nil face2))
|
(cond
|
((equal dest match))
|
((not match))
|
((eq what 'range)
|
(ignore-errors (org-table-get-range match table-start nil 'highlight)))
|
((setq e (assoc var org-table-named-field-locations))
|
(org-table-goto-field var)
|
(org-table-highlight-rectangle)
|
(message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
|
((setq e (assoc var org-table-column-names))
|
(org-table-goto-column (string-to-number (cdr e)))
|
(org-table-highlight-rectangle)
|
(goto-char table-start)
|
(if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
|
(org-table-end) t)
|
(progn
|
(goto-char (match-beginning 1))
|
(org-table-highlight-rectangle)
|
(message "Named column (column %s)" (cdr e)))
|
(user-error "Column name not found")))
|
((eq what 'column)
|
;; Column number.
|
(org-table-goto-column (string-to-number (substring match 1)))
|
(org-table-highlight-rectangle)
|
(message "Column %s" (substring match 1)))
|
((setq e (assoc var org-table-local-parameters))
|
(goto-char table-start)
|
(if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
|
(progn
|
(goto-char (match-beginning 1))
|
(org-table-highlight-rectangle)
|
(message "Local parameter."))
|
(user-error "Parameter not found")))
|
((not var) (user-error "No reference at point"))
|
((setq e (assoc var org-table-formula-constants-local))
|
(message "Local Constant: $%s=%s in #+CONSTANTS line."
|
var (cdr e)))
|
((setq e (assoc var org-table-formula-constants))
|
(message "Constant: $%s=%s in `org-table-formula-constants'."
|
var (cdr e)))
|
((setq e (and (fboundp 'constants-get) (constants-get var)))
|
(message "Constant: $%s=%s, from `constants.el'%s."
|
var e (format " (%s units)" constants-unit-system)))
|
(t (user-error "Undefined name $%s" var)))
|
(goto-char pos)
|
(when (and org-show-positions
|
(not (memq this-command '(org-table-fedit-scroll
|
org-table-fedit-scroll-down))))
|
(push pos org-show-positions)
|
(push table-start org-show-positions)
|
(let ((min (apply 'min org-show-positions))
|
(max (apply 'max org-show-positions)))
|
(set-window-start (selected-window) min)
|
(goto-char max)
|
(or (pos-visible-in-window-p max)
|
(set-window-start (selected-window) max)))))
|
(select-window win))))
|
|
(defun org-table-force-dataline ()
|
"Make sure the cursor is in a dataline in a table."
|
(unless (save-excursion
|
(beginning-of-line 1)
|
(looking-at org-table-dataline-regexp))
|
(let* ((re org-table-dataline-regexp)
|
(p1 (save-excursion (re-search-forward re nil 'move)))
|
(p2 (save-excursion (re-search-backward re nil 'move))))
|
(cond ((and p1 p2)
|
(goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point))))
|
p1 p2)))
|
((or p1 p2) (goto-char (or p1 p2)))
|
(t (user-error "No table dataline around here"))))))
|
|
(defun org-table-fedit-line-up ()
|
"Move cursor one line up in the window showing the table."
|
(interactive)
|
(org-table-fedit-move 'previous-line))
|
|
(defun org-table-fedit-line-down ()
|
"Move cursor one line down in the window showing the table."
|
(interactive)
|
(org-table-fedit-move 'next-line))
|
|
(defun org-table-fedit-move (command)
|
"Move the cursor in the window showing the table.
|
Use COMMAND to do the motion, repeat if necessary to end up in a data line."
|
(let ((org-table-allow-automatic-line-recalculation nil)
|
(pos org-pos) (win (selected-window)) p)
|
(select-window (get-buffer-window (marker-buffer org-pos)))
|
(setq p (point))
|
(call-interactively command)
|
(while (and (org-at-table-p)
|
(org-at-table-hline-p))
|
(call-interactively command))
|
(or (org-at-table-p) (goto-char p))
|
(move-marker pos (point))
|
(select-window win)))
|
|
(defun org-table-fedit-scroll (N)
|
(interactive "p")
|
(let ((other-window-scroll-buffer (marker-buffer org-pos)))
|
(scroll-other-window N)))
|
|
(defun org-table-fedit-scroll-down (N)
|
(interactive "p")
|
(org-table-fedit-scroll (- N)))
|
|
(defvar org-table-rectangle-overlays nil)
|
|
(defun org-table-add-rectangle-overlay (beg end &optional face)
|
"Add a new overlay."
|
(let ((ov (make-overlay beg end)))
|
(overlay-put ov 'face (or face 'secondary-selection))
|
(push ov org-table-rectangle-overlays)))
|
|
(defun org-table-highlight-rectangle (&optional beg end face)
|
"Highlight rectangular region in a table.
|
When buffer positions BEG and END are provided, use them to
|
delimit the region to highlight. Otherwise, refer to point. Use
|
FACE, when non-nil, for the highlight."
|
(let* ((beg (or beg (point)))
|
(end (or end (point)))
|
(b (min beg end))
|
(e (max beg end))
|
(start-coordinates
|
(save-excursion
|
(goto-char b)
|
(cons (line-beginning-position) (org-table-current-column))))
|
(end-coordinates
|
(save-excursion
|
(goto-char e)
|
(cons (line-beginning-position) (org-table-current-column)))))
|
(when (boundp 'org-show-positions)
|
(setq org-show-positions (cons b (cons e org-show-positions))))
|
(goto-char (car start-coordinates))
|
(let ((column-start (min (cdr start-coordinates) (cdr end-coordinates)))
|
(column-end (max (cdr start-coordinates) (cdr end-coordinates)))
|
(last-row (car end-coordinates)))
|
(while (<= (point) last-row)
|
(when (looking-at org-table-dataline-regexp)
|
(org-table-goto-column column-start)
|
(skip-chars-backward "^|\n")
|
(let ((p (point)))
|
(org-table-goto-column column-end)
|
(skip-chars-forward "^|\n")
|
(org-table-add-rectangle-overlay p (point) face)))
|
(forward-line)))
|
(goto-char (car start-coordinates)))
|
(add-hook 'before-change-functions #'org-table-remove-rectangle-highlight))
|
|
(defun org-table-remove-rectangle-highlight (&rest _ignore)
|
"Remove the rectangle overlays."
|
(unless org-inhibit-highlight-removal
|
(remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
|
(mapc 'delete-overlay org-table-rectangle-overlays)
|
(setq org-table-rectangle-overlays nil)))
|
|
(defvar-local org-table-coordinate-overlays nil
|
"Collects the coordinate grid overlays, so that they can be removed.")
|
|
(defun org-table-overlay-coordinates ()
|
"Add overlays to the table at point, to show row/column coordinates."
|
(interactive)
|
(mapc 'delete-overlay org-table-coordinate-overlays)
|
(setq org-table-coordinate-overlays nil)
|
(save-excursion
|
(let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
|
(goto-char (org-table-begin))
|
(while (org-at-table-p)
|
(setq eol (point-at-eol))
|
(setq ov (make-overlay (point-at-bol) (1+ (point-at-bol))))
|
(push ov org-table-coordinate-overlays)
|
(setq hline (looking-at org-table-hline-regexp))
|
(setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
|
(format "%4d" (setq id (1+ id)))))
|
(org-overlay-before-string ov str 'org-special-keyword 'evaporate)
|
(when hline
|
(setq ic 0)
|
(while (re-search-forward "[+|]\\(-+\\)" eol t)
|
(setq beg (1+ (match-beginning 0))
|
ic (1+ ic)
|
s1 (concat "$" (int-to-string ic))
|
s2 (org-number-to-letters ic)
|
str (if (eq org-table-use-standard-references t) s2 s1))
|
(setq ov (make-overlay beg (+ beg (length str))))
|
(push ov org-table-coordinate-overlays)
|
(org-overlay-display ov str 'org-special-keyword 'evaporate)))
|
(beginning-of-line 2)))))
|
|
;;;###autoload
|
(defun org-table-toggle-coordinate-overlays ()
|
"Toggle the display of Row/Column numbers in tables."
|
(interactive)
|
(setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
|
(message "Tables Row/Column numbers display turned %s"
|
(if org-table-overlay-coordinates "on" "off"))
|
(if (and (org-at-table-p) org-table-overlay-coordinates)
|
(org-table-align))
|
(unless org-table-overlay-coordinates
|
(mapc 'delete-overlay org-table-coordinate-overlays)
|
(setq org-table-coordinate-overlays nil)))
|
|
;;;###autoload
|
(defun org-table-toggle-formula-debugger ()
|
"Toggle the formula debugger in tables."
|
(interactive)
|
(setq org-table-formula-debug (not org-table-formula-debug))
|
(message "Formula debugging has been turned %s"
|
(if org-table-formula-debug "on" "off")))
|
|
;;; The orgtbl minor mode
|
|
;; Define a minor mode which can be used in other modes in order to
|
;; integrate the Org table editor.
|
|
;; This is really a hack, because the Org table editor uses several
|
;; keys which normally belong to the major mode, for example the TAB
|
;; and RET keys. Here is how it works: The minor mode defines all the
|
;; keys necessary to operate the table editor, but wraps the commands
|
;; into a function which tests if the cursor is currently inside
|
;; a table. If that is the case, the table editor command is
|
;; executed. However, when any of those keys is used outside a table,
|
;; the function uses `key-binding' to look up if the key has an
|
;; associated command in another currently active keymap (minor modes,
|
;; major mode, global), and executes that command. There might be
|
;; problems if any of the keys used by the table editor is otherwise
|
;; used as a prefix key.
|
|
;; Another challenge is that the key binding for TAB can be tab or \C-i,
|
;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
|
;; addresses this by checking explicitly for both bindings.
|
|
;; The optimized version (see variable `orgtbl-optimized') takes over
|
;; all keys which are bound to `self-insert-command' in the *global map*.
|
;; Some modes bind other commands to simple characters, for example
|
;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode
|
;; active, this binding is ignored inside tables and replaced with a
|
;; modified self-insert.
|
|
|
(defvar orgtbl-mode-map (make-keymap)
|
"Keymap for `orgtbl-mode'.")
|
|
(defvar org-old-auto-fill-inhibit-regexp nil
|
"Local variable used by `orgtbl-mode'.")
|
|
(defconst orgtbl-line-start-regexp
|
"[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)"
|
"Matches a line belonging to an orgtbl.")
|
|
(defconst orgtbl-extra-font-lock-keywords
|
(list (list (concat "^" orgtbl-line-start-regexp ".*")
|
0 (quote 'org-table) 'prepend))
|
"Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.")
|
|
;; Install it as a minor mode.
|
(put 'orgtbl-mode :included t)
|
(put 'orgtbl-mode :menu-tag "Org Table Mode")
|
|
;;;###autoload
|
(define-minor-mode orgtbl-mode
|
"The Org mode table editor as a minor mode for use in other modes."
|
:lighter " OrgTbl" :keymap orgtbl-mode-map
|
(org-load-modules-maybe)
|
(cond
|
((derived-mode-p 'org-mode)
|
;; Exit without error, in case some hook functions calls this by
|
;; accident in Org mode.
|
(message "Orgtbl mode is not useful in Org mode, command ignored"))
|
(orgtbl-mode
|
(and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?!
|
;; Make sure we are first in minor-mode-map-alist
|
(let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
|
;; FIXME: maybe it should use emulation-mode-map-alists?
|
(and c (setq minor-mode-map-alist
|
(cons c (delq c minor-mode-map-alist)))))
|
(setq-local org-table-may-need-update t)
|
(add-hook 'before-change-functions 'org-before-change-function
|
nil 'local)
|
(setq-local org-old-auto-fill-inhibit-regexp
|
auto-fill-inhibit-regexp)
|
(setq-local auto-fill-inhibit-regexp
|
(if auto-fill-inhibit-regexp
|
(concat orgtbl-line-start-regexp "\\|"
|
auto-fill-inhibit-regexp)
|
orgtbl-line-start-regexp))
|
(add-to-invisibility-spec '(org-cwidth))
|
(when (fboundp 'font-lock-add-keywords)
|
(font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
|
(org-restart-font-lock))
|
(easy-menu-add orgtbl-mode-menu))
|
(t
|
(setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
|
(org-table-cleanup-narrow-column-properties)
|
(org-remove-from-invisibility-spec '(org-cwidth))
|
(remove-hook 'before-change-functions 'org-before-change-function t)
|
(when (fboundp 'font-lock-remove-keywords)
|
(font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
|
(org-restart-font-lock))
|
(easy-menu-remove orgtbl-mode-menu)
|
(force-mode-line-update 'all))))
|
|
(defun org-table-cleanup-narrow-column-properties ()
|
"Remove all properties related to narrow-column invisibility."
|
(let ((s (point-min)))
|
(while (setq s (text-property-any s (point-max)
|
'display org-narrow-column-arrow))
|
(remove-text-properties s (1+ s) '(display t)))
|
(setq s (point-min))
|
(while (setq s (text-property-any s (point-max) 'org-cwidth 1))
|
(remove-text-properties s (1+ s) '(org-cwidth t)))
|
(setq s (point-min))
|
(while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
|
(remove-text-properties s (1+ s) '(invisible t)))))
|
|
(defun orgtbl-make-binding (fun n &rest keys)
|
"Create a function for binding in the table minor mode.
|
FUN is the command to call inside a table. N is used to create a unique
|
command name. KEYS are keys that should be checked in for a command
|
to execute outside of tables."
|
(eval
|
(list 'defun
|
(intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
|
'(arg)
|
(concat "In tables, run `" (symbol-name fun) "'.\n"
|
"Outside of tables, run the binding of `"
|
(mapconcat #'key-description keys "' or `")
|
"'.")
|
'(interactive "p")
|
(list 'if
|
'(org-at-table-p)
|
(list 'call-interactively (list 'quote fun))
|
(list 'let '(orgtbl-mode)
|
(list 'call-interactively
|
(append '(or)
|
(mapcar (lambda (k)
|
(list 'key-binding k))
|
keys)
|
'('orgtbl-error))))))))
|
|
(defun orgtbl-error ()
|
"Error when there is no default binding for a table key."
|
(interactive)
|
(user-error "This key has no function outside tables"))
|
|
(defun orgtbl-setup ()
|
"Setup orgtbl keymaps."
|
(let ((nfunc 0)
|
(bindings
|
'(([(meta shift left)] org-table-delete-column)
|
([(meta left)] org-table-move-column-left)
|
([(meta right)] org-table-move-column-right)
|
([(meta shift right)] org-table-insert-column)
|
([(meta shift up)] org-table-kill-row)
|
([(meta shift down)] org-table-insert-row)
|
([(meta up)] org-table-move-row-up)
|
([(meta down)] org-table-move-row-down)
|
("\C-c\C-w" org-table-cut-region)
|
("\C-c\M-w" org-table-copy-region)
|
("\C-c\C-y" org-table-paste-rectangle)
|
("\C-c\C-w" org-table-wrap-region)
|
("\C-c-" org-table-insert-hline)
|
("\C-c}" org-table-toggle-coordinate-overlays)
|
("\C-c{" org-table-toggle-formula-debugger)
|
("\C-m" org-table-next-row)
|
([(shift return)] org-table-copy-down)
|
("\C-c?" org-table-field-info)
|
("\C-c " org-table-blank-field)
|
("\C-c+" org-table-sum)
|
("\C-c=" org-table-eval-formula)
|
("\C-c'" org-table-edit-formulas)
|
("\C-c`" org-table-edit-field)
|
("\C-c*" org-table-recalculate)
|
("\C-c^" org-table-sort-lines)
|
("\M-a" org-table-beginning-of-field)
|
("\M-e" org-table-end-of-field)
|
([(control ?#)] org-table-rotate-recalc-marks)))
|
elt key fun cmd)
|
(while (setq elt (pop bindings))
|
(setq nfunc (1+ nfunc))
|
(setq key (org-key (car elt))
|
fun (nth 1 elt)
|
cmd (orgtbl-make-binding fun nfunc key))
|
(org-defkey orgtbl-mode-map key cmd))
|
|
;; Special treatment needed for TAB, RET and DEL
|
(org-defkey orgtbl-mode-map [(return)]
|
(orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
|
(org-defkey orgtbl-mode-map "\C-m"
|
(orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
|
(org-defkey orgtbl-mode-map [(tab)]
|
(orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
|
(org-defkey orgtbl-mode-map "\C-i"
|
(orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
|
(org-defkey orgtbl-mode-map [(shift tab)]
|
(orgtbl-make-binding 'org-table-previous-field 104
|
[(shift tab)] [(tab)] "\C-i"))
|
(org-defkey orgtbl-mode-map [backspace]
|
(orgtbl-make-binding 'org-delete-backward-char 109
|
[backspace] (kbd "DEL")))
|
|
(org-defkey orgtbl-mode-map [S-iso-lefttab]
|
(orgtbl-make-binding 'org-table-previous-field 107
|
[S-iso-lefttab] [backtab] [(shift tab)]
|
[(tab)] "\C-i"))
|
|
(org-defkey orgtbl-mode-map [backtab]
|
(orgtbl-make-binding 'org-table-previous-field 108
|
[backtab] [S-iso-lefttab] [(shift tab)]
|
[(tab)] "\C-i"))
|
|
(org-defkey orgtbl-mode-map "\M-\C-m"
|
(orgtbl-make-binding 'org-table-wrap-region 105
|
"\M-\C-m" [(meta return)]))
|
(org-defkey orgtbl-mode-map [(meta return)]
|
(orgtbl-make-binding 'org-table-wrap-region 106
|
[(meta return)] "\M-\C-m"))
|
|
(org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
|
(org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region)
|
|
(when orgtbl-optimized
|
;; If the user wants maximum table support, we need to hijack
|
;; some standard editing functions
|
(org-remap orgtbl-mode-map
|
'self-insert-command 'orgtbl-self-insert-command
|
'delete-char 'org-delete-char
|
'delete-backward-char 'org-delete-backward-char)
|
(org-defkey orgtbl-mode-map "|" 'org-force-self-insert))
|
(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
|
'("OrgTbl"
|
["Create or convert" org-table-create-or-convert-from-region
|
:active (not (org-at-table-p)) :keys "C-c |" ]
|
"--"
|
["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
|
["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
|
["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
|
["Next Row" org-return :active (org-at-table-p) :keys "RET"]
|
"--"
|
["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
|
["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
|
["Copy Field from Above"
|
org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
|
"--"
|
("Column"
|
["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
|
["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
|
["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
|
["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
|
("Row"
|
["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
|
["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
|
["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
|
["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
|
["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"]
|
"--"
|
["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
|
("Rectangle"
|
["Copy Rectangle" org-copy-special :active (org-at-table-p)]
|
["Cut Rectangle" org-cut-special :active (org-at-table-p)]
|
["Paste Rectangle" org-paste-special :active (org-at-table-p)]
|
["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
|
"--"
|
("Radio tables"
|
["Insert table template" orgtbl-insert-radio-table
|
(cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)]
|
["Comment/uncomment table" orgtbl-toggle-comment t])
|
"--"
|
["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
|
["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
|
["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
|
["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
|
["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
|
["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
|
["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
|
["Sum Column/Rectangle" org-table-sum
|
:active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
|
["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
|
["Debug Formulas"
|
org-table-toggle-formula-debugger :active (org-at-table-p)
|
:keys "C-c {"
|
:style toggle :selected org-table-formula-debug]
|
["Show Col/Row Numbers"
|
org-table-toggle-coordinate-overlays :active (org-at-table-p)
|
:keys "C-c }"
|
:style toggle :selected org-table-overlay-coordinates]
|
"--"
|
("Plot"
|
["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
|
["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
|
t))
|
|
(defun orgtbl-ctrl-c-ctrl-c (arg)
|
"If the cursor is inside a table, realign the table.
|
If it is a table to be sent away to a receiver, do it.
|
With prefix arg, also recompute table."
|
(interactive "P")
|
(let ((case-fold-search t) (pos (point)) action)
|
(save-excursion
|
(beginning-of-line 1)
|
(setq action (cond
|
((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
|
((looking-at "[ \t]*|") pos)
|
((looking-at "[ \t]*#\\+tblfm:") 'recalc))))
|
(cond
|
((integerp action)
|
(goto-char action)
|
(org-table-maybe-eval-formula)
|
(if arg
|
(call-interactively 'org-table-recalculate)
|
(org-table-maybe-recalculate-line))
|
(call-interactively 'org-table-align)
|
(when (orgtbl-send-table 'maybe)
|
(run-hooks 'orgtbl-after-send-table-hook)))
|
((eq action 'recalc)
|
(save-excursion
|
(beginning-of-line 1)
|
(skip-chars-backward " \r\n\t")
|
(if (org-at-table-p)
|
(org-call-with-arg 'org-table-recalculate t))))
|
(t (let (orgtbl-mode)
|
(call-interactively (key-binding "\C-c\C-c")))))))
|
|
(defun orgtbl-create-or-convert-from-region (_arg)
|
"Create table or convert region to table, if no conflicting binding.
|
This installs the table binding `C-c |', but only if there is no
|
conflicting binding to this key outside orgtbl-mode."
|
(interactive "P")
|
(let* (orgtbl-mode (cmd (key-binding "\C-c|")))
|
(if cmd
|
(call-interactively cmd)
|
(call-interactively 'org-table-create-or-convert-from-region))))
|
|
(defun orgtbl-tab (arg)
|
"Justification and field motion for `orgtbl-mode'."
|
(interactive "P")
|
(if arg (org-table-edit-field t)
|
(org-table-justify-field-maybe)
|
(org-table-next-field)))
|
|
(defun orgtbl-ret ()
|
"Justification and field motion for `orgtbl-mode'."
|
(interactive)
|
(if (bobp)
|
(newline)
|
(org-table-justify-field-maybe)
|
(org-table-next-row)))
|
|
(defun orgtbl-self-insert-command (N)
|
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
|
If the cursor is in a table looking at whitespace, the whitespace is
|
overwritten, and the table is not marked as requiring realignment."
|
(interactive "p")
|
(if (and (org-at-table-p)
|
(or
|
(and org-table-auto-blank-field
|
(member last-command
|
'(orgtbl-hijacker-command-100
|
orgtbl-hijacker-command-101
|
orgtbl-hijacker-command-102
|
orgtbl-hijacker-command-103
|
orgtbl-hijacker-command-104
|
orgtbl-hijacker-command-105
|
yas/expand))
|
(org-table-blank-field))
|
t)
|
(eq N 1)
|
(looking-at "[^|\n]* \\( \\)|"))
|
(let (org-table-may-need-update)
|
(delete-region (match-beginning 1) (match-end 1))
|
(self-insert-command N))
|
(setq org-table-may-need-update t)
|
(let* (orgtbl-mode
|
a
|
(cmd (or (key-binding
|
(or (and (listp function-key-map)
|
(setq a (assoc last-input-event function-key-map))
|
(cdr a))
|
(vector last-input-event)))
|
'self-insert-command)))
|
(call-interactively cmd)
|
(if (and org-self-insert-cluster-for-undo
|
(eq cmd 'self-insert-command))
|
(if (not (eq last-command 'orgtbl-self-insert-command))
|
(setq org-self-insert-command-undo-counter 1)
|
(if (>= org-self-insert-command-undo-counter 20)
|
(setq org-self-insert-command-undo-counter 1)
|
(and (> org-self-insert-command-undo-counter 0)
|
buffer-undo-list
|
(not (cadr buffer-undo-list)) ; remove nil entry
|
(setcdr buffer-undo-list (cddr buffer-undo-list)))
|
(setq org-self-insert-command-undo-counter
|
(1+ org-self-insert-command-undo-counter))))))))
|
|
;;;###autoload
|
(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
|
"Regular expression matching exponentials as produced by calc.")
|
|
(defun orgtbl-gather-send-defs ()
|
"Gather a plist of :name, :transform, :params for each destination before
|
a radio table."
|
(save-excursion
|
(goto-char (org-table-begin))
|
(let (rtn)
|
(beginning-of-line 0)
|
(while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
|
(let ((name (org-no-properties (match-string 1)))
|
(transform (intern (match-string 2)))
|
(params (if (match-end 3)
|
(read (concat "(" (match-string 3) ")")))))
|
(push (list :name name :transform transform :params params)
|
rtn)
|
(beginning-of-line 0)))
|
rtn)))
|
|
(defun orgtbl-send-replace-tbl (name text)
|
"Find and replace table NAME with TEXT."
|
(save-excursion
|
(goto-char (point-min))
|
(let* ((location-flag nil)
|
(name (regexp-quote name))
|
(begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))
|
(end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)))
|
(while (re-search-forward begin-re nil t)
|
(unless location-flag (setq location-flag t))
|
(let ((beg (line-beginning-position 2)))
|
(unless (re-search-forward end-re nil t)
|
(user-error "Cannot find end of receiver location at %d" beg))
|
(beginning-of-line)
|
(delete-region beg (point))
|
(insert text "\n")))
|
(unless location-flag
|
(user-error "No valid receiver location found in the buffer")))))
|
|
;;;###autoload
|
(defun org-table-to-lisp (&optional txt)
|
"Convert the table at point to a Lisp structure.
|
The structure will be a list. Each item is either the symbol `hline'
|
for a horizontal separator line, or a list of field values as strings.
|
The table is taken from the parameter TXT, or from the buffer at point."
|
(unless (or txt (org-at-table-p)) (user-error "No table at point"))
|
(let ((txt (or txt
|
(buffer-substring-no-properties (org-table-begin)
|
(org-table-end)))))
|
(mapcar (lambda (x)
|
(if (string-match org-table-hline-regexp x) 'hline
|
(org-split-string (org-trim x) "\\s-*|\\s-*")))
|
(org-split-string txt "[ \t]*\n[ \t]*"))))
|
|
(defun orgtbl-send-table (&optional maybe)
|
"Send a transformed version of table at point to the receiver position.
|
With argument MAYBE, fail quietly if no transformation is defined
|
for this table."
|
(interactive)
|
(catch 'exit
|
(unless (org-at-table-p) (user-error "Not at a table"))
|
;; when non-interactive, we assume align has just happened.
|
(when (called-interactively-p 'any) (org-table-align))
|
(let ((dests (orgtbl-gather-send-defs))
|
(table (org-table-to-lisp
|
(buffer-substring-no-properties (org-table-begin)
|
(org-table-end))))
|
(ntbl 0))
|
(unless dests
|
(if maybe (throw 'exit nil)
|
(user-error "Don't know how to transform this table")))
|
(dolist (dest dests)
|
(let ((name (plist-get dest :name))
|
(transform (plist-get dest :transform))
|
(params (plist-get dest :params)))
|
(unless (fboundp transform)
|
(user-error "No such transformation function %s" transform))
|
(orgtbl-send-replace-tbl name (funcall transform table params)))
|
(cl-incf ntbl))
|
(message "Table converted and installed at %d receiver location%s"
|
ntbl (if (> ntbl 1) "s" ""))
|
(and (> ntbl 0) ntbl))))
|
|
(defun org-remove-by-index (list indices &optional i0)
|
"Remove the elements in LIST with indices in INDICES.
|
First element has index 0, or I0 if given."
|
(if (not indices)
|
list
|
(if (integerp indices) (setq indices (list indices)))
|
(setq i0 (1- (or i0 0)))
|
(delq :rm (mapcar (lambda (x)
|
(setq i0 (1+ i0))
|
(if (memq i0 indices) :rm x))
|
list))))
|
|
(defun orgtbl-toggle-comment ()
|
"Comment or uncomment the orgtbl at point."
|
(interactive)
|
(let* ((case-fold-search t)
|
(re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
|
(re2 (concat "^" orgtbl-line-start-regexp))
|
(commented (save-excursion (beginning-of-line 1)
|
(cond ((looking-at re1) t)
|
((looking-at re2) nil)
|
(t (user-error "Not at an org table")))))
|
(re (if commented re1 re2))
|
beg end)
|
(save-excursion
|
(beginning-of-line 1)
|
(while (looking-at re) (beginning-of-line 0))
|
(beginning-of-line 2)
|
(setq beg (point))
|
(while (looking-at re) (beginning-of-line 2))
|
(setq end (point)))
|
(comment-region beg end (if commented '(4) nil))))
|
|
(defun orgtbl-insert-radio-table ()
|
"Insert a radio table template appropriate for this major mode."
|
(interactive)
|
(let* ((e (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates))
|
(txt (nth 1 e))
|
name pos)
|
(unless e (user-error "No radio table setup defined for %s" major-mode))
|
(setq name (read-string "Table name: "))
|
(while (string-match "%n" txt)
|
(setq txt (replace-match name t t txt)))
|
(or (bolp) (insert "\n"))
|
(setq pos (point))
|
(insert txt)
|
(goto-char pos)))
|
|
;;;###autoload
|
(defun orgtbl-to-generic (table params)
|
"Convert the orgtbl-mode TABLE to some other format.
|
|
This generic routine can be used for many standard cases.
|
|
TABLE is a list, each entry either the symbol `hline' for
|
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:
|
|
:backend, :raw
|
|
Export back-end used as a basis to transcode elements of the
|
table, when no specific parameter applies to it. It is also
|
used to translate cells contents. You can prevent this by
|
setting :raw property to a non-nil value.
|
|
:splice
|
|
When non-nil, only convert rows, not the table itself. This is
|
equivalent to setting to the empty string both :tstart
|
and :tend, which see.
|
|
:skip
|
|
When set to an integer N, skip the first N lines of the table.
|
Horizontal separation lines do count for this parameter!
|
|
:skipcols
|
|
List of columns that should be skipped. If the table has
|
a column with calculation marks, that column is automatically
|
discarded beforehand.
|
|
:hline
|
|
String to be inserted on horizontal separation lines. May be
|
nil to ignore these lines altogether.
|
|
:sep
|
|
Separator between two fields, as a string.
|
|
Each in the following group may be either a string or a function
|
of no arguments returning a string:
|
|
:tstart, :tend
|
|
Strings to start and end the table. Ignored when :splice is t.
|
|
:lstart, :lend
|
|
Strings to start and end a new table line.
|
|
:llstart, :llend
|
|
Strings to start and end the last table line. Default,
|
respectively, to :lstart and :lend.
|
|
Each in the following group may be a string or a function of one
|
argument (either the cells in the current row, as a list of
|
strings, or the current cell) returning a string:
|
|
:lfmt
|
|
Format string for an entire row, with enough %s to capture all
|
fields. When non-nil, :lstart, :lend, and :sep are ignored.
|
|
:llfmt
|
|
Format for the entire last line, defaults to :lfmt.
|
|
:fmt
|
|
A format to be used to wrap the field, should contain %s for
|
the original field value. For example, to wrap everything in
|
dollars, you could use :fmt \"$%s$\". This may also be
|
a property list with column numbers and format strings, or
|
functions, e.g.,
|
|
(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
|
|
:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
|
|
Same as above, specific for the header lines in the table.
|
All lines before the first hline are treated as header. If
|
any of these is not present, the data line value is used.
|
|
This may be either a string or a function of two arguments:
|
|
:efmt
|
|
Use this format to print numbers with exponential. The format
|
should have %s twice for inserting mantissa and exponent, for
|
example \"%s\\\\times10^{%s}\". This may also be a property
|
list with column numbers and format strings or functions.
|
:fmt will still be applied after :efmt."
|
;; Make sure `org-export-create-backend' is available.
|
(require 'ox)
|
(let* ((backend (plist-get params :backend))
|
(custom-backend
|
;; Build a custom back-end according to PARAMS. Before
|
;; defining a translator, check if there is anything to do.
|
;; When there isn't, let BACKEND handle the element.
|
(org-export-create-backend
|
:parent (or backend 'org)
|
:transcoders
|
`((table . ,(org-table--to-generic-table params))
|
(table-row . ,(org-table--to-generic-row params))
|
(table-cell . ,(org-table--to-generic-cell params))
|
;; Macros are not going to be expanded. However, no
|
;; regular back-end 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)
|
;; Store TABLE as Org syntax in DATA. Tolerate non-string cells.
|
;; Initialize communication channel in INFO.
|
(with-temp-buffer
|
(let ((org-inhibit-startup t)) (org-mode))
|
(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")))))
|
;; Add back-end 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)))
|
(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-element 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-element 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 (eq (org-element-type 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
|
;; back-end 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) ""))))
|
|
(defun org-table--generic-apply (value name &optional with-cons &rest args)
|
(cond ((null value) nil)
|
((functionp value) `(funcall ',value ,@args))
|
((stringp value)
|
(cond ((consp (car args)) `(apply #'format ,value ,@args))
|
(args `(format ,value ,@args))
|
(t value)))
|
((and with-cons (consp value))
|
`(let ((val (cadr (memq column ',value))))
|
(cond ((null val) contents)
|
((stringp val) (format val ,@args))
|
((functionp val) (funcall val ,@args))
|
(t (user-error "Wrong %s value" ,name)))))
|
(t (user-error "Wrong %s value" name))))
|
|
(defun org-table--to-generic-table (params)
|
"Return custom table transcoder according to PARAMS.
|
PARAMS is a plist. See `orgtbl-to-generic' for more
|
information."
|
(let ((backend (plist-get params :backend))
|
(splice (plist-get params :splice))
|
(tstart (plist-get params :tstart))
|
(tend (plist-get params :tend)))
|
`(lambda (table contents info)
|
(concat
|
,(and tstart (not splice)
|
`(concat ,(org-table--generic-apply tstart ":tstart") "\n"))
|
,(if (or (not backend) tstart tend splice) 'contents
|
`(org-export-with-backend ',backend table contents info))
|
,(org-table--generic-apply (and (not splice) tend) ":tend")))))
|
|
(defun org-table--to-generic-row (params)
|
"Return custom table row transcoder according to PARAMS.
|
PARAMS is a plist. See `orgtbl-to-generic' for more
|
information."
|
(let* ((backend (plist-get params :backend))
|
(lstart (plist-get params :lstart))
|
(llstart (plist-get params :llstart))
|
(hlstart (plist-get params :hlstart))
|
(hllstart (plist-get params :hllstart))
|
(lend (plist-get params :lend))
|
(llend (plist-get params :llend))
|
(hlend (plist-get params :hlend))
|
(hllend (plist-get params :hllend))
|
(lfmt (plist-get params :lfmt))
|
(llfmt (plist-get params :llfmt))
|
(hlfmt (plist-get params :hlfmt))
|
(hllfmt (plist-get params :hllfmt)))
|
`(lambda (row contents info)
|
(if (eq (org-element-property :type row) 'rule)
|
,(cond
|
((plist-member params :hline)
|
(org-table--generic-apply (plist-get params :hline) ":hline"))
|
(backend `(org-export-with-backend ',backend row nil info)))
|
(let ((headerp ,(and (or hlfmt hlstart hlend)
|
'(org-export-table-row-in-header-p row info)))
|
(last-header-p
|
,(and (or hllfmt hllstart hllend)
|
'(org-export-table-row-ends-header-p row info)))
|
(lastp (not (org-export-get-next-element row info))))
|
(when contents
|
;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
|
;; `:hllfmt' to CONTENTS. Otherwise, fallback on
|
;; `:lstart', `:lend' and their relatives.
|
,(let ((cells
|
'(org-element-map row 'table-cell
|
(lambda (cell)
|
;; Export all cells, without separators.
|
;;
|
;; Use `org-export-data-with-backend'
|
;; instead of `org-export-data' to eschew
|
;; cached values, which
|
;; ignore :orgtbl-ignore-sep parameter.
|
(org-export-data-with-backend
|
cell
|
(plist-get info :back-end)
|
(org-combine-plists info '(:orgtbl-ignore-sep t))))
|
info)))
|
`(cond
|
,(and hllfmt
|
`(last-header-p ,(org-table--generic-apply
|
hllfmt ":hllfmt" nil cells)))
|
,(and hlfmt
|
`(headerp ,(org-table--generic-apply
|
hlfmt ":hlfmt" nil cells)))
|
,(and llfmt
|
`(lastp ,(org-table--generic-apply
|
llfmt ":llfmt" nil cells)))
|
(t
|
,(if lfmt (org-table--generic-apply lfmt ":lfmt" nil cells)
|
`(concat
|
(cond
|
,(and
|
(or hllstart hllend)
|
`(last-header-p
|
(concat
|
,(org-table--generic-apply hllstart ":hllstart")
|
contents
|
,(org-table--generic-apply hllend ":hllend"))))
|
,(and
|
(or hlstart hlend)
|
`(headerp
|
(concat
|
,(org-table--generic-apply hlstart ":hlstart")
|
contents
|
,(org-table--generic-apply hlend ":hlend"))))
|
,(and
|
(or llstart llend)
|
`(lastp
|
(concat
|
,(org-table--generic-apply llstart ":llstart")
|
contents
|
,(org-table--generic-apply llend ":llend"))))
|
(t
|
,(cond
|
((or lstart lend)
|
`(concat
|
,(org-table--generic-apply lstart ":lstart")
|
contents
|
,(org-table--generic-apply lend ":lend")))
|
(backend
|
`(org-export-with-backend
|
',backend row contents info))
|
(t 'contents)))))))))))))))
|
|
(defun org-table--to-generic-cell (params)
|
"Return custom table cell transcoder according to PARAMS.
|
PARAMS is a plist. See `orgtbl-to-generic' for more
|
information."
|
(let* ((backend (plist-get params :backend))
|
(efmt (plist-get params :efmt))
|
(fmt (plist-get params :fmt))
|
(hfmt (plist-get params :hfmt))
|
(sep (plist-get params :sep))
|
(hsep (plist-get params :hsep)))
|
`(lambda (cell contents info)
|
;; Make sure that contents are exported as Org data when :raw
|
;; parameter is non-nil.
|
,(when (and backend (plist-get params :raw))
|
`(setq contents
|
;; Since we don't know what are the pseudo object
|
;; types defined in backend, we cannot pass them to
|
;; `org-element-interpret-data'. As a consequence,
|
;; they will be treated as pseudo elements, and will
|
;; have newlines appended instead of spaces.
|
;; Therefore, we must make sure :post-blank value is
|
;; really turned into spaces.
|
(replace-regexp-in-string
|
"\n" " "
|
(org-trim
|
(org-element-interpret-data
|
(org-element-contents cell))))))
|
|
(let ((headerp ,(and (or hfmt hsep)
|
'(org-export-table-row-in-header-p
|
(org-export-get-parent-element cell) info)))
|
(column
|
;; Call costly `org-export-table-cell-address' only if
|
;; absolutely necessary, i.e., if one
|
;; of :fmt :efmt :hfmt has a "plist type" value.
|
,(and (cl-some (lambda (v) (integerp (car-safe v)))
|
(list efmt hfmt fmt))
|
'(1+ (cdr (org-export-table-cell-address cell info))))))
|
(when contents
|
;; Check if we can apply `:efmt' on CONTENTS.
|
,(when efmt
|
`(when (string-match orgtbl-exp-regexp contents)
|
(let ((mantissa (match-string 1 contents))
|
(exponent (match-string 2 contents)))
|
(setq contents ,(org-table--generic-apply
|
efmt ":efmt" t 'mantissa 'exponent)))))
|
;; Check if we can apply FMT (or HFMT) on CONTENTS.
|
(cond
|
,(and hfmt `(headerp (setq contents ,(org-table--generic-apply
|
hfmt ":hfmt" t 'contents))))
|
,(and fmt `(t (setq contents ,(org-table--generic-apply
|
fmt ":fmt" t 'contents))))))
|
;; If a separator is provided, use it instead of BACKEND's.
|
;; Separators are ignored when LFMT (or equivalent) is
|
;; provided.
|
,(cond
|
((or hsep sep)
|
`(if (or ,(and (not sep) '(not headerp))
|
(plist-get info :orgtbl-ignore-sep)
|
(not (org-export-get-next-element cell info)))
|
,(if (not backend) 'contents
|
`(org-export-with-backend ',backend cell contents info))
|
(concat contents
|
,(if (and sep hsep) `(if headerp ,hsep ,sep)
|
(or hsep sep)))))
|
(backend `(org-export-with-backend ',backend cell contents info))
|
(t 'contents))))))
|
|
;;;###autoload
|
(defun orgtbl-to-tsv (table params)
|
"Convert the orgtbl-mode table to TAB separated material."
|
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
|
|
;;;###autoload
|
(defun orgtbl-to-csv (table params)
|
"Convert the orgtbl-mode table to CSV material.
|
This does take care of the proper quoting of fields with comma or quotes."
|
(orgtbl-to-generic table
|
(org-combine-plists '(:sep "," :fmt org-quote-csv-field)
|
params)))
|
|
;;;###autoload
|
(defun orgtbl-to-latex (table params)
|
"Convert the orgtbl-mode TABLE to LaTeX.
|
|
TABLE is a list, each entry either the symbol `hline' for
|
a horizontal separator line, or a list of fields for that line.
|
PARAMS is a property list of parameters that can influence the
|
conversion. All parameters from `orgtbl-to-generic' are
|
supported. It is also possible to use the following ones:
|
|
:booktabs
|
|
When non-nil, use formal \"booktabs\" style.
|
|
:environment
|
|
Specify environment to use, as a string. If you use
|
\"longtable\", you may also want to specify :language property,
|
as a string, to get proper continuation strings."
|
(require 'ox-latex)
|
(orgtbl-to-generic
|
table
|
(org-combine-plists
|
;; Provide sane default values.
|
(list :backend 'latex
|
:latex-default-table-mode 'table
|
:latex-tables-centered nil
|
:latex-tables-booktabs (plist-get params :booktabs)
|
:latex-table-scientific-notation nil
|
:latex-default-table-environment
|
(or (plist-get params :environment) "tabular"))
|
params)))
|
|
;;;###autoload
|
(defun orgtbl-to-html (table params)
|
"Convert the orgtbl-mode TABLE to HTML.
|
|
TABLE is a list, each entry either the symbol `hline' for
|
a horizontal separator line, or a list of fields for that line.
|
PARAMS is a property list of parameters that can influence the
|
conversion. All parameters from `orgtbl-to-generic' are
|
supported. It is also possible to use the following one:
|
|
:attributes
|
|
Attributes and values, as a plist, which will be used in
|
<table> tag."
|
(require 'ox-html)
|
(orgtbl-to-generic
|
table
|
(org-combine-plists
|
;; Provide sane default values.
|
(list :backend 'html
|
:html-table-data-tags '("<td%s>" . "</td>")
|
:html-table-use-header-tags-for-first-column nil
|
:html-table-align-individual-fields t
|
:html-table-row-tags '("<tr>" . "</tr>")
|
:html-table-attributes
|
(if (plist-member params :attributes)
|
(plist-get params :attributes)
|
'(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups"
|
:frame "hsides")))
|
params)))
|
|
;;;###autoload
|
(defun orgtbl-to-texinfo (table params)
|
"Convert the orgtbl-mode TABLE to Texinfo.
|
|
TABLE is a list, each entry either the symbol `hline' for
|
a horizontal separator line, or a list of fields for that line.
|
PARAMS is a property list of parameters that can influence the
|
conversion. All parameters from `orgtbl-to-generic' are
|
supported. It is also possible to use the following one:
|
|
:columns
|
|
Column widths, as a string. When providing column fractions,
|
\"@columnfractions\" command can be omitted."
|
(require 'ox-texinfo)
|
(let ((output
|
(orgtbl-to-generic
|
table
|
(org-combine-plists
|
(list :backend 'texinfo
|
:texinfo-tables-verbatim nil
|
:texinfo-table-scientific-notation nil)
|
params)))
|
(columns (let ((w (plist-get params :columns)))
|
(cond ((not w) nil)
|
((string-match-p "{\\|@columnfractions " w) w)
|
(t (concat "@columnfractions " w))))))
|
(if (not columns) output
|
(replace-regexp-in-string
|
"@multitable \\(.*\\)" columns output t nil 1))))
|
|
;;;###autoload
|
(defun orgtbl-to-orgtbl (table params)
|
"Convert the orgtbl-mode TABLE into another orgtbl-mode table.
|
|
TABLE is a list, each entry either the symbol `hline' for
|
a horizontal separator line, or a list of fields for that line.
|
PARAMS is a property list of parameters that can influence the
|
conversion. All parameters from `orgtbl-to-generic' are
|
supported.
|
|
Useful when slicing one table into many. The :hline, :sep,
|
:lstart, and :lend provide orgtbl framing. :tstart and :tend can
|
be set to provide ORGTBL directives for the generated table."
|
(require 'ox-org)
|
(orgtbl-to-generic table (org-combine-plists params (list :backend 'org))))
|
|
(defun orgtbl-to-table.el (table params)
|
"Convert the orgtbl-mode TABLE into a table.el table.
|
TABLE is a list, each entry either the symbol `hline' for
|
a horizontal separator line, or a list of fields for that line.
|
PARAMS is a property list of parameters that can influence the
|
conversion. All parameters from `orgtbl-to-generic' are
|
supported."
|
(with-temp-buffer
|
(insert (orgtbl-to-orgtbl table params))
|
(org-table-align)
|
(replace-regexp-in-string
|
"-|" "-+"
|
(replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size))))))
|
|
(defun orgtbl-to-unicode (table params)
|
"Convert the orgtbl-mode TABLE into a table with unicode characters.
|
|
TABLE is a list, each entry either the symbol `hline' for
|
a horizontal separator line, or a list of fields for that line.
|
PARAMS is a property list of parameters that can influence the
|
conversion. All parameters from `orgtbl-to-generic' are
|
supported. It is also possible to use the following ones:
|
|
:ascii-art
|
|
When non-nil, use \"ascii-art-to-unicode\" package to translate
|
the table. You can download it here:
|
http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
|
|
:narrow
|
|
When non-nil, narrow columns width than provided width cookie,
|
using \"=>\" as an ellipsis, just like in an Org mode buffer."
|
(require 'ox-ascii)
|
(orgtbl-to-generic
|
table
|
(org-combine-plists
|
(list :backend 'ascii
|
:ascii-charset 'utf-8
|
:ascii-table-widen-columns (not (plist-get params :narrow))
|
:ascii-table-use-ascii-art (plist-get params :ascii-art))
|
params)))
|
|
;; Put the cursor in a column containing numerical values
|
;; of an Org table,
|
;; type C-c " a
|
;; A new column is added with a bar plot.
|
;; When the table is refreshed (C-u C-c *),
|
;; the plot is updated to reflect the new values.
|
|
(defun orgtbl-ascii-draw (value min max &optional width characters)
|
"Draw an ascii bar in a table.
|
VALUE is the value to plot, it determines the width of the bar to draw.
|
MIN is the value that will be displayed as empty (zero width bar).
|
MAX is the value that will draw a bar filling all the WIDTH.
|
WIDTH is the span in characters from MIN to MAX.
|
CHARACTERS is a string that will compose the bar, with shades of grey
|
from pure white to pure black. It defaults to a 10 characters string
|
of regular ascii characters."
|
(let* ((width (ceiling (or width 12)))
|
(characters (or characters " .:;c!lhVHW"))
|
(len (1- (length characters)))
|
(value (float (if (numberp value)
|
value (string-to-number value))))
|
(relative (/ (- value min) (- max min)))
|
(steps (round (* relative width len))))
|
(cond ((< steps 0) "too small")
|
((> steps (* width len)) "too large")
|
(t (let* ((int-division (/ steps len))
|
(remainder (- steps (* int-division len))))
|
(concat (make-string int-division (elt characters len))
|
(string (elt characters remainder))))))))
|
|
;;;###autoload
|
(defun orgtbl-ascii-plot (&optional ask)
|
"Draw an ASCII bar plot in a column.
|
|
With cursor in a column containing numerical values, this function
|
will draw a plot in a new column.
|
|
ASK, if given, is a numeric prefix to override the default 12
|
characters width of the plot. ASK may also be the `\\[universal-argument]' \
|
prefix,
|
which will prompt for the width."
|
(interactive "P")
|
(let ((col (org-table-current-column))
|
(min 1e999) ; 1e999 will be converted to infinity
|
(max -1e999) ; which is the desired result
|
(table (org-table-to-lisp))
|
(length
|
(cond ((consp ask)
|
(read-number "Length of column " 12))
|
((numberp ask) ask)
|
(t 12))))
|
;; Skip any hline a the top of table.
|
(while (eq (car table) 'hline) (setq table (cdr table)))
|
;; Skip table header if any.
|
(dolist (x (or (cdr (memq 'hline table)) table))
|
(when (consp x)
|
(setq x (nth (1- col) x))
|
(when (string-match
|
"^[-+]?\\([0-9]*[.]\\)?[0-9]*\\([eE][+-]?[0-9]+\\)?$"
|
x)
|
(setq x (string-to-number x))
|
(when (> min x) (setq min x))
|
(when (< max x) (setq max x)))))
|
(org-table-insert-column)
|
(org-table-move-column-right)
|
(org-table-store-formulas
|
(cons
|
(cons
|
(concat "$" (number-to-string (1+ col)))
|
(format "'(%s $%s %s %s %s)"
|
"orgtbl-ascii-draw" col min max length))
|
(org-table-get-stored-formulas)))
|
(org-table-recalculate t)))
|
|
;; Example of extension: unicode characters
|
;; Here are two examples of different styles.
|
|
;; Unicode block characters are used to give a smooth effect.
|
;; See http://en.wikipedia.org/wiki/Block_Elements
|
;; Use one of those drawing functions
|
;; - orgtbl-ascii-draw (the default ascii)
|
;; - orgtbl-uc-draw-grid (unicode with a grid effect)
|
;; - orgtbl-uc-draw-cont (smooth unicode)
|
|
;; This is best viewed with the "DejaVu Sans Mono" font
|
;; (use M-x set-frame-font).
|
|
(defun orgtbl-uc-draw-grid (value min max &optional width)
|
"Draw a bar in a table using block unicode characters.
|
It is a variant of orgtbl-ascii-draw with Unicode block
|
characters, for a smooth display. Bars appear as grids (to the
|
extent the font allows)."
|
;; http://en.wikipedia.org/wiki/Block_Elements
|
;; best viewed with the "DejaVu Sans Mono" font.
|
(orgtbl-ascii-draw value min max width
|
" \u258F\u258E\u258D\u258C\u258B\u258A\u2589"))
|
|
(defun orgtbl-uc-draw-cont (value min max &optional width)
|
"Draw a bar in a table using block unicode characters.
|
It is a variant of orgtbl-ascii-draw with Unicode block
|
characters, for a smooth display. Bars are solid (to the extent
|
the font allows)."
|
(orgtbl-ascii-draw value min max width
|
" \u258F\u258E\u258D\u258C\u258B\u258A\u2589\u2588"))
|
|
(defun org-table-get-remote-range (name-or-id form)
|
"Get a field value or a list of values in a range from table at ID.
|
|
NAME-OR-ID may be the name of a table in the current file as set
|
by a \"#+NAME:\" directive. The first table following this line
|
will then be used. Alternatively, it may be an ID referring to
|
any entry, also in a different file. In this case, the first
|
table in that entry will be referenced.
|
FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
|
\"@I$2..@II$2\". All the references must be absolute, not relative.
|
|
The return value is either a single string for a single field, or a
|
list of the fields in the rectangle."
|
(save-match-data
|
(let ((case-fold-search t) (id-loc nil)
|
;; Protect a bunch of variables from being overwritten by
|
;; the context of the remote table.
|
org-table-column-names org-table-column-name-regexp
|
org-table-local-parameters org-table-named-field-locations
|
org-table-current-line-types
|
org-table-current-begin-pos org-table-dlines
|
org-table-current-ncol
|
org-table-hlines org-table-last-alignment
|
org-table-last-column-widths org-table-last-alignment
|
org-table-last-column-widths
|
buffer loc)
|
(setq form (org-table-convert-refs-to-rc form))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(if (re-search-forward
|
(concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
|
(regexp-quote name-or-id) "[ \t]*$")
|
nil t)
|
(setq buffer (current-buffer) loc (match-beginning 0))
|
(setq id-loc (org-id-find name-or-id 'marker))
|
(unless (and id-loc (markerp id-loc))
|
(user-error "Can't find remote table \"%s\"" name-or-id))
|
(setq buffer (marker-buffer id-loc)
|
loc (marker-position id-loc))
|
(move-marker id-loc nil))
|
(with-current-buffer buffer
|
(org-with-wide-buffer
|
(goto-char loc)
|
(forward-char 1)
|
(unless (and (re-search-forward "^\\(\\*+ \\)\\|^[ \t]*|" nil t)
|
(not (match-beginning 1)))
|
(user-error "Cannot find a table at NAME or ID %s" name-or-id))
|
(org-table-analyze)
|
(setq form (org-table-formula-substitute-names
|
(org-table-formula-handle-first/last-rc form)))
|
(if (and (string-match org-table-range-regexp form)
|
(> (length (match-string 0 form)) 1))
|
(org-table-get-range
|
(match-string 0 form) org-table-current-begin-pos 1)
|
form)))))))
|
|
(defun org-table-remote-reference-indirection (form)
|
"Return formula with table remote references substituted by indirection.
|
For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\".
|
This indirection works only with the format @ROW$COLUMN. The
|
format \"B3\" is not supported because it can not be
|
distinguished from a plain table name or ID."
|
(let ((regexp
|
;; Same as in `org-table-eval-formula'.
|
(concat "\\<remote([ \t]*\\("
|
;; Allow "$1", "@<", "$-1", "@<<$1" etc.
|
"[@$][^ \t,]+"
|
"\\)[ \t]*,[ \t]*\\([^\n)]+\\))")))
|
(replace-regexp-in-string
|
regexp
|
(lambda (m)
|
(save-match-data
|
(let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m))))
|
(org-table-get-range
|
(if (string-match-p "\\`\\$[0-9]+\\'" eq)
|
(concat "@0" eq)
|
eq)))))
|
form t t 1)))
|
|
(defmacro org-define-lookup-function (mode)
|
(let ((mode-str (symbol-name mode))
|
(first-p (eq mode 'first))
|
(all-p (eq mode 'all)))
|
(let ((plural-str (if all-p "s" "")))
|
`(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate)
|
,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST.
|
If R-LIST is nil, return matching element%s of S-LIST.
|
If PREDICATE is not nil, use it instead of `equal' to match VAL.
|
Matching is done by (PREDICATE VAL S), where S is an element of S-LIST.
|
This function is generated by a call to the macro `org-define-lookup-function'."
|
mode-str plural-str plural-str plural-str)
|
(let ,(let ((lvars '((p (or predicate 'equal))
|
(sl s-list)
|
(rl (or r-list s-list))
|
(ret nil))))
|
(if first-p (cons '(match-p nil) lvars) lvars))
|
(while ,(if first-p '(and (not match-p) sl) 'sl)
|
(when (funcall p val (car sl))
|
,(when first-p '(setq match-p t))
|
(let ((rval (car rl)))
|
(setq ret ,(if all-p '(append ret (list rval)) 'rval))))
|
(setq sl (cdr sl) rl (cdr rl)))
|
ret)))))
|
|
(org-define-lookup-function first)
|
(org-define-lookup-function last)
|
(org-define-lookup-function all)
|
|
(provide 'org-table)
|
|
;; Local variables:
|
;; generated-autoload-file: "org-loaddefs.el"
|
;; End:
|
|
;;; org-table.el ends here
|
